home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 173bbas.zip / RBBSSUB3.BAS < prev    next >
BASIC Source File  |  1990-10-28  |  120KB  |  3,433 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB3.BAS 17.3B, Copyright 1986 - 90 by D. Thomas Mack'  ' DA081003
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB3.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: August 26, 1990; October 28, 1990
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  AllCaps         58050 Convert a string to all upper case characters
  18. '  AMorPM          41498 Calculate the current time as AM or PM
  19. '  AskGraphics     43004 Determine users graphic default
  20. '  BadFile         20741 Check for system crash attempt with bad device name
  21. '  Carrier         42000 Test for whether to continue in RBBS
  22. '  CheckRatio      20096 Test upload/download ratio
  23. '  CheckTime       58070 Test to insure that users don't exceed their time
  24. '  CheckCarrier    42005 Checks whether still have carrier
  25. '  CheckNewBul     58110 Check for new bulletins based on their file creation date
  26. '  CheckTimeRemain 41008 Set up to log off if time exceeded
  27. '  CommInfo        44020 Get users baud rate and parity in a string format
  28. '  CountLines      58160 Count categories a file can be classified into
  29. '  CountNewFiles   58150 Check for number of files uploaded after a specific date
  30. '  DelayTime       50495 Wait number of seconds specified before returning
  31. '  DispCall        57001 Display callers file
  32. '  DispTimeRemain  41032 Compute and display time remaining
  33. '  DispUpDir       58165 Display the shared directory of the FMS mng. sys.
  34. '  FileLock        21993 Allow files to be shared among multiple RBBS-PC's
  35. '  FindFKey        30595 Handle local keyboard's function & ZSysop's keys
  36. '  FindLast        58600 Finds last occurence of a string in a string
  37. '  FlushKeys       35000  Completely flush all user input
  38. '  Graphic         43031 Determines if graphic ver of file exists, opens as #2
  39. '  GraphicX        43031 Determines if graphic ver of file exists, any file #
  40. '  HashRBBS        58080 "Hash" to a user's record in the USERS file
  41. '  InitFMS         58162 Initialize the RBBS-PC's File Management System
  42. '  InitIBM         30000 Open/create NetBIOS semaphore file
  43. '  AddCommas       58130 Format commands in the command prompt
  44. '  Library         21105 Provide support for "library" drives
  45. '  LinesInFile     58161 Counts lines in a file
  46. '  LoadNew         58140 Find the latest uploads
  47. '  ModemPut        52070 Write a modem command string to the modem
  48. '  NameCaps        58060 Convert a string to Proper Case (for name output)
  49. '  OpenMsg         30500 Open the messages file as file number 1
  50. '  PageUp          33202 Display user info. on local screen for ZSysop
  51. '  ReadProf        44000 Read user's profile on return from a "door"
  52. '  SaveProf        43068 Save the user's provile when exiting to "doors" or DOS
  53. '  SendName        20293 Send filename via EXEC-PC protocol during autodownload
  54. '  SetOpts         58100 Set correct prompt line for each subsystem
  55. '  SortString      58120 Sort characters in a string
  56. '  TestUser        20310 Check if user's software can do auto downloading
  57. '  TimeRemain      41010 Compute time remaining in minutes
  58. '  UpdtUpload      20705 Updates upload directory file
  59. '  WildFile        20290 Determines whether string matches a pattern
  60. '  XferType        21600 Identify the file transfer protocol
  61. '
  62. '  $INCLUDE: 'RBBS-VAR.BAS'
  63. '
  64. 20290 ' $SUBTITLE: 'WildFile -- Matches file to a filespec'
  65. ' $PAGE
  66. '  NAME    -- WildFile
  67. '
  68. '  INPUTS  -- PARAMETER             MEANING
  69. '             Pattern$           PATTERN TO CHECK AGAINST
  70. '             ItemToMatch$       FILE NAME TO MATCH
  71. '
  72. '  OUTPUTS -- DoesMatch         WHETHER MATCHES
  73. '
  74. '  PURPOSE  Determine whether a file name is an instance of
  75. '    a file specification.  Exactly like DOS except that ? must have a
  76. '    character.
  77. '
  78.       SUB WildFile (Pattern$,ItemToMatch$,DoesMatch) STATIC
  79.       IF Pattern$ <> PrevPattern$ THEN _
  80.          CALL BreakFileName (Pattern$,PDrive$,PPrefix$,PExt$,ZFalse) : _
  81.          PrevPattern$ = Pattern$
  82.       CALL BreakFileName (ItemToMatch$,IDrive$,IPrefix$,IExt$,ZFalse)
  83.       DoesMatch = ZFalse
  84.       IF PDrive$ <> "" AND PDrive$ <> IDrive$ THEN _
  85.          EXIT SUB
  86.       CALL WildCard (PPrefix$,IPrefix$)
  87.       IF NOT ZOK THEN _
  88.          EXIT SUB
  89.       CALL WildCard (PExt$,IExt$)
  90.       DoesMatch = ZOK
  91.       END SUB
  92. 20293 ' $SUBTITLE: 'SendName - send FILENAME using EXEC-PC protocol'
  93. ' $PAGE
  94. '
  95. '  NAME    -- SendName
  96. '
  97. '  INPUTS  --  PARAMETER                    MEANING
  98. '              ZUserIn$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  99. '              ZAnsIndex                 Index OF FILENAME TO Transfer ' RH021501
  100. '
  101. '  OUTPUTS --  ZAbort                    -1 FOR AN ABORTED ATTEMPT
  102. '
  103. '  PURPOSE -- Send the download filename to user during an autodownload
  104. '
  105.       SUB SendName STATIC
  106. '
  107. '
  108. ' *  Transfer FILENAME TO USER
  109. ' *         PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- <ESC>OD
  110. ' *                   THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER
  111. ' *                   TRANSMISSION OF THE FILENAME WITH ECHO.  IF ANY OF THE
  112. ' *                   CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF
  113. ' *                   <CAN> ARE SENT, OTHERWISE AN <ACK> IS SENT AT
  114. ' *                   COMPLETION AND FILE Transfer BEGINS.
  115. '
  116. '
  117.       ZAbort = ZFalse                    ' RESET ABORT FLAG
  118.       Attempts = 0                       ' RESET COUNT FOR # OF TRANS Attempts
  119. 20295 CALL DelayTime (1)                 ' ONE SECOND DELAY
  120. 20296 CALL FlushCom(ZWasY$)              ' CLEAR THE COMM BUFFER OF GARBAGE
  121.       IF ZSubParm = -1 THEN _
  122.          EXIT SUB
  123.       CALL PutCom (ZEscape$+"OD")         ' SEND "ALERT" STRING
  124.       IF ZSubParm = -1 THEN _
  125.          EXIT SUB
  126.       IF ZAbort = ZTrue THEN _
  127.          GOTO 20306
  128.       CALL LPrnt("Sending FILENAME -- ",1)
  129.       CALL LPrnt(ZReturnLineFeed$ + CHR$(9),0)
  130.       CALL DelayTime (1)                   ' WAIT 1 SECOND FOR SETUP
  131. '
  132. '               SEND ONE CHARACTER AT A TIME
  133. '
  134.       CALL BreakFileName (ZUserIn$(ZAnsIndex),WasX$,ZOutTxt$,ZWasY$,ZTrue) ' RH021501
  135.       ZOutTxt$ = ZOutTxt$ + ZWasY$ + "=X"                            ' RH021501
  136.       FOR WasX = 1 TO LEN(ZOutTxt$)
  137.          CALL PutCom (MID$(ZOutTxt$,WasX,1))     ' SEND 1 CHARACTER
  138.          IF ZSubParm = -1 THEN _
  139.             EXIT SUB
  140.          IF ZAbort = ZTrue THEN _
  141.             GOTO 20306
  142.          CALL LPrnt(MID$(ZOutTxt$,WasX,1),0)     ' DISPLAY IF NEEDED
  143.          ZDelay! = TIMER + 10            ' SET MAXIMUM TIME TO WAIT FOR Reply
  144.          Char = ZTrue
  145.          WHILE Char = -1
  146.             CALL CheckTime(ZDelay!, TempElapsed!, 1)
  147.             IF TempElapsed! <= 0 THEN _
  148.                GOTO 20300     ' IF ZNo ECHO, CANCEL FILENAME Transfer
  149.             CALL EofComm (Char)
  150.          WEND                 ' JUMP OUT IF CHARACTER IS RECEIVED
  151. 20298    CALL FlushCom(ZWasY$)    ' COLLECT CHARACTER(ZWasS) USER ECHOED
  152.          IF ZSubParm = -1 THEN _
  153.             EXIT SUB
  154.          IF MID$(ZOutTxt$,WasX,1) = ZWasY$ THEN _
  155.             GOTO 20305         ' IF CORRECTLY ECHOED, THEN CONTINUE
  156.          IF INSTR(ZWasY$,ZCancel$) THEN _
  157.             ZAbort = ZTrue : _
  158.             GOTO 20306          ' CHECK FOR USER ZAbort
  159. 20300    CALL PutCom (STRING$(5,24)) ' TELL USER THAT FILE NAME IS GARBLED
  160.          IF ZSubParm = - 1 THEN _
  161.             EXIT SUB
  162.          IF ZAbort = ZTrue THEN _
  163.             GOTO 20306
  164.          CALL LPrnt("Name Trans Failure",1) ' DISPLAY FAILURE ON SCREEN
  165.          Attempts = Attempts + 1  ' INCREMENT COUNTER FOR # WasOF TRIES
  166.          IF Attempts < 6 THEN _   ' TRY IT FIVE TIMES, THEN GIVE UP
  167.             GOTO 20295
  168.          CALL PutCom (STRING$(50,24)) ' GUARANTEE CANCELLATION WasOF USER
  169.          IF ZSubParm = -1 THEN _
  170.             EXIT SUB
  171.          IF ZAbort = ZTrue THEN _
  172.             GOTO 20306
  173.          IF ZSnoop THEN _
  174.             CALL LPrnt("ABORTING AUTODOWNLOAD!",1) : _
  175.             ZAbort = ZTrue : _
  176.             GOTO 20306
  177. '
  178. 20305 NEXT                               ' LOOP BACK FOR NEXT CHARACTER
  179. '
  180.       CALL PutCom (ZAcknowledge$)    ' WHEN FILENAME SENT, ACKNOWLEDGE
  181.       IF ZSubParm = -1 THEN _
  182.          EXIT SUB
  183.       CALL SkipLine(1)              ' CLEAN UP Sysop's DISPLAY
  184. '
  185. '                COMPLETION OF AUTODOWNLOAD FILENAME Transfer
  186. '
  187. 20306 END SUB
  188. 20310 ' $SUBTITLE: 'TestUser - interrogate user for AUTO-Downloading support'
  189. ' $PAGE
  190. '
  191. '  NAME    -- TestUser
  192. '
  193. '  INPUTS  -- NONE
  194. '
  195. '  OUTPUTS -- ZAutoDownYes         -1 IF USER'S COMMUNICATION
  196. '                                  SOFTWARE CAN DO AUTODOWNLOADING
  197. '
  198. '             ZAutoDownVerified    TRUE IF COMMUNICATIONS PGM
  199. '                                  EVER CHECKED
  200. '
  201. '  PURPOSE -- Send the user an <ESCAPE><XON> and if response
  202. '             is a recognized package, set appropriate flag.
  203. '
  204.       SUB TestUser STATIC
  205. '
  206. '
  207. ' *    TEST FOR COMMUNICATIONS USING WasN,8,1 Protocol AND EXECPC Talk VER 2.0+
  208. ' *     TO SEE IF CALLER CAN USE THE AUTODOWNLOAD FEATURE
  209. '
  210. '
  211.       ZAbort = ZFalse
  212.       ZAutoDownVerified = ZTrue
  213.       CALL FlushCom(ZWasY$)                          ' FLUSH THE COMM BUFFER
  214.       IF ZSubParm = -1 THEN _
  215.          EXIT SUB
  216.       CALL PutCom (ZEscape$ + ZXOn$)
  217.       IF ZAbort = ZTrue THEN _
  218.          GOTO 20315
  219.       CALL DelayTime (2)                         ' WAIT TWO SECONDS FOR Reply
  220. 20313 CALL FlushCom(ZWasY$)                      ' GET CONTENTS OF COMM BUFFER
  221.       IF ZSubParm = -1 THEN _
  222.          EXIT SUB
  223.       IF INSTR(ZWasY$,"EXECPC") THEN _
  224.          ZComProgram = 1
  225.       IF INSTR(ZWasY$,"PIBTERM") THEN _
  226.          ZComProgram = 2
  227.       IF INSTR(ZWasY$,"PROCOMM") THEN _
  228.          ZComProgram = 3
  229.       IF INSTR(ZWasY$,"QMODEM") THEN _
  230.          ZComProgram = 4
  231.       ZAutoDownYes = (ZComProgram > 0 AND ZComProgram < 3)
  232. 20315 END SUB
  233. 20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory'
  234. ' $PAGE
  235. '  NAME    -- UpdtUpload
  236. '
  237. '  INPUTS  -- PARAMETER             MEANING
  238. '             ZFileName$
  239. '             ZUpldDir$
  240. '             ZFileNameHold$
  241. '             ZShareIt
  242. '             ZFMSDirectory$
  243. '             ZWasQ!
  244. '             ZSecsUsedSession!
  245. '
  246. '  OUTPUTS -- ZBytesInFile#
  247. '             ZSecsPerSession!
  248. '
  249. '  PURPOSE -- Upon a successful upload, add entry to the upload
  250. '             directory and give any session time credit.
  251. '
  252.       SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1), LinesInDesc) STATIC
  253.       IF ZGetExtDesc THEN _
  254.          GOTO 20723
  255.       GOSUB 20734
  256.       CALL TimeRemain (MinsRemaining)
  257.       IF ZPrivateDoor THEN _
  258.          WasX! = ZUpldTimeFactor! * ZWasQ! _
  259.       ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!)
  260.       CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZFalse)
  261.       WasX$ = ZDiskForDos$ + "T" + Ext$ + ".BAT"
  262.       CALL FindIt (WasX$)
  263.       IF NOT ZOK THEN _
  264.          GOTO 20708
  265.       CALL QuickTPut1 ("Testing if file OK...") : _                  ' KG072601
  266.       CALL ReadDir (2,1)
  267.       IF EOF(2) THEN _
  268.          WasX$ = ZOutTxt$ : _
  269.          ZGSRAra$(1) = ZFileName$ : _
  270.          ZGSRAra$(2) = ZNodeWorkFile$ _
  271.       ELSE WasX$ = WasX$ + " " + _
  272.            ZFileName$ + " " + ZNodeWorkFile$
  273.       CALL ShellExit (WasX$)
  274.       CALL FindIt (ZNodeWorkFile$)
  275.       IF ZOK THEN _
  276.          IF LOF(2) > 2 THEN _
  277.             ZBytesInFile# = 0.0 : _
  278.             WasX$ = "Deleting BAD upload " + ZFileNameHold$ : _
  279.             CALL QuickTPut1 (WasX$) : _
  280.             CALL UpdtCalr (WasX$,2) : _
  281.             CALL KillWork (ZFileName$) : _
  282.             EXIT SUB
  283. 20708 WasX$ = ZDiskForDos$ + "C" + Ext$ + ZDefaultExtension$ + ".BAT"
  284.       CALL FindIt (WasX$)
  285.       IF NOT ZOK THEN _
  286.          GOTO 20709
  287.       ZOutTxt$ = "Converting"
  288.       IF Ext$ = ZDefaultExtension$ THEN _
  289.          ZOutTxt$ = "Re-" + ZOutTxt$
  290.       CALL QuickTPut1 (ZOutTxt$ + " upload to "+ZDefaultExtension$+".  Please wait...")
  291.       CALL ReadDir (2,1)
  292.       IF EOF(2) THEN _
  293.          WasX$ = ZOutTxt$
  294.       ZGSRAra$(1) = ZFileName$
  295.       CALL BreakFileName (ZFileName$,Pre$,Body$,Ext$,ZTrue)
  296.       ZFileNameHold$ = Body$ + "." + ZDefaultExtension$
  297.       ZUserIn$(0) = ZFileName$
  298.       ZFileName$ = Pre$ + ZFileNameHold$
  299.       CALL ShellExit (WasX$ + " " + Body$ + " " + ZNodeID$)
  300.       CALL FindIt (ZFileName$)
  301.       IF NOT ZOK THEN _
  302.          ZFileName$ = ZGSRAra$(1) : _
  303.          CALL FindIt (ZFileName$) : _
  304.          ZFileNameHold$ = Body$ + Ext$ : _
  305.          IF ZOK THEN _
  306.             GOTO 20709
  307.       GOSUB 20736
  308. 20709 CALL QuickTPut1 ("Upload successful")
  309.       WasX$ = DATE$
  310.       ZWasZ$ = LEFT$(WasX$,6) + _
  311.            RIGHT$(WasX$,2)
  312.       StrewTo$ = ""
  313.       UCat$ = ""
  314. 20710 CALL QuickTPut1 ("Describe " + ZFileNameHold$ + _
  315.            " (Begin with '/' if for SYSOP only)")
  316.       CALL QuickTPut1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
  317.                  ZMaxDescLen - 4) + "..Max>")
  318.       CALL QuickTPut ("? ",0)
  319.       ZOutTxt$ = ""
  320.       ZSubParm = 1
  321.       ZParseOff = ZTrue
  322.       CALL TGet
  323.       CALL Carrier
  324.       IF ZSubParm = -1 THEN _
  325.          ZUserIn$ = "<description unavailable>": _
  326.          GOTO 20712
  327.       IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 10 THEN _
  328.          CALL QuickTPut1 ("10 chars min," + STR$(ZMaxDescLen) + " max") : _
  329.          GOTO 20710
  330. 20712 ZOK = 0
  331.       CALL CheckNovell (ZOK)
  332.       IF ZOK <> -1 THEN _
  333.          CALL SetSharedAttr (ZFileName$, ZOK) : _
  334.          IF ZOK <> 0 THEN _
  335.             CALL PScrn ("Error setting to shared")                   ' KG072701
  336.       Desc$ = ZUserIn$
  337.       IF NOT ZLimitSearchToFMS THEN _
  338.          IF ZFMSDirectory$ <> ZUpldDir$ THEN _
  339.             IF LEFT$(ZUserIn$,1) = "/" THEN _
  340.                CALL UpdtCalr (ZUserIn$,2) : _
  341.                GOTO 20726_
  342.             ELSE GOTO 20717
  343. 20715 IF LEFT$(ZUserIn$,1) = "/" THEN _
  344.          UCat$ = "***" : _
  345.          GOTO 20722
  346.       UCat$ = ZDefaultCatCode$
  347. 20717 IF ZSubParm = -1 OR _
  348.          ZUserSecLevel < ZSLCategorizeUplds THEN _
  349.          GOTO 20722
  350. 20719 CALL BufFile (ZUpcatHelp$,WasX)
  351. 20720 ZOutTxt$= "Upload best fits what category (D=default,H=help)"
  352.       ZSubParm = 1
  353.       CALL TGet
  354.       CALL AllCaps (ZUserIn$(1))
  355.       IF ZSubParm = -1 OR ZUserIn$(1) = "D" THEN _
  356.          UCat$ = ZDefaultCatCode$ : _                                ' KG071704
  357.          GOTO 20722
  358.       IF ZWasQ = 0 THEN _
  359.          GOTO 20719
  360.       IF ZUserIn$(1) = "H" OR _
  361.          ZUserIn$(1) = "*" OR _
  362.          ZUserIn$(1) = "?" THEN _
  363.          GOTO 20719
  364.       CALL SearchArray (ZUserIn$(1),ZCategoryName$(),ZNumCategories,Found)
  365.       IF Found > 0 THEN _
  366.          UCat$ = ZCategoryCode$(Found) : _
  367.          IF LEN(UCat$) > 0 AND LEN(UCat$) < 4 AND INSTR(UCat$,",") = 0 THEN _
  368.             GOTO 20722
  369.       UCat$ = ""
  370.       IF NOT ZLimitSearchToFMS THEN _
  371.          StrewTo$ = ZDirPath$ + _
  372.                      ZUserIn$(1) + _
  373.                      "." + _
  374.                      ZDirExtension$ : _
  375.          CALL FindIt (StrewTo$) : _
  376.          IF ZOK THEN _
  377.             GOTO 20722 _
  378.          ELSE CALL WordInFile (ZUpcatHelp$,ZUserIn$(1),ZOK) : _
  379.               IF ZOK THEN _
  380.                  GOTO 20722
  381.       StrewTo$ = ""
  382.       CALL QuickTPut1 ("No such category " + ZUserIn$(1))
  383.       GOTO 20719
  384. 20722 IF ZUserSecLevel >= ZAskExtendedDesc AND _
  385.          ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _
  386.          ZOutTxt$ = "Add an extended description of " + _            ' DA071701
  387.               ZFileNameHold$ + " ([Y],N)" : _
  388.          ZTurboKey = -ZTurboKeyUser : _
  389.          ZSubParm = 1 : _
  390.          CALL TGet : _
  391.          IF ZSubParm <> -1 THEN _
  392.             IF NOT ZNo THEN _
  393.                ZGetExtDesc = ZTrue : _
  394.                EXIT SUB
  395. 20723 ZUserIn$ = Desc$
  396.       WasX$ = DATE$
  397.       ZWasZ$ = LEFT$(WasX$,6) + _
  398.            RIGHT$(WasX$,2)
  399.       ZWasEN$ = StrewTo$
  400.       GOSUB 20730
  401.       ZWasEN$ = ZAllwaysStrewTo$
  402.       GOSUB 20730
  403. 20725 ZWasEN$ = ZUpldDir$
  404.       GOSUB 20730
  405. 20726 ZWasDF$ = " >> uploaded << "
  406.       ZUplds = ZUplds + 1
  407.       ZGlobalUplds = ZGlobalUplds + 1
  408.       ZULBytes! = ZULBytes! + ZBytesInFile#
  409.       ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile#
  410.       CALL Muzak (7)
  411.       CALL TimeRemain (MinsRemaining)
  412.       ZTimeCredits! = ZTimeCredits! + WasX!
  413.       ZSecsPerSession! = ZSecsPerSession! + WasX!
  414.       IF ZPrivateDoor THEN _
  415.          WasX! = (WasX! - ZWasQ!) / 60 _
  416.       ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0
  417.       WasX$ = STR$(FIX(WasX!*10.0))
  418.       WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1)
  419.       IF WasX! > 1 THEN _
  420.          CALL QuickTPut1 ("Increased session time by"+WasX$+" minutes") ' KG072701
  421.       CALL QuickTPut1 ("Thanks for the upload!")
  422.       ZGetExtDesc = ZFalse
  423.       EXIT SUB
  424. 20730 '          ---[ lock file ]---
  425.       IF ZWasEN$ = "" THEN _
  426.          RETURN
  427.       FMSFormat = ZFalse
  428.       IF ZWasEN$ = ZFMSDirectory$ OR ZLimitSearchToFMS THEN _
  429.          FMSFormat = ZTrue _
  430.       ELSE CALL FindIt (ZWasEN$) : _
  431.            IF ZOK THEN _
  432.               CALL ReadDir (2,1) : _
  433.               IF ZErrCode = 0 THEN _
  434.                  FMSFormat = (LEFT$(ZOutTxt$,4) = "\FMS")
  435.       IF NOT FMSFormat THEN _
  436.          ReadBackwards = ZFalse : _
  437.          FixedLen = 0 : _
  438.          ZUserIn$ = Desc$ _
  439.       ELSE FixedLen = 34 + ZMaxDescLen : _
  440.            ZUserIn$ = Desc$ + _
  441.                 SPACE$(ZMaxDescLen - LEN(Desc$)) + _
  442.                 UCat$ + _
  443.                 SPACE$(3 - LEN(UCat$)) : _
  444.            ReadBackwards = ZTrue : _
  445.            CALL FindIt (ZWasEN$) : _
  446.            IF ZOK THEN _
  447.               CALL ReadDir (2,1) : _
  448.               IF ZErrCode = 0 THEN _
  449.                  ReadBackwards = (INSTR(ZOutTxt$," TOP ") = 0)
  450.       CALL LockAppend
  451.       IF ZErrCode <> 0 THEN _
  452.          GOTO  20731
  453.       '          ---[ append ]---
  454.       IF ZGetExtDesc THEN _
  455.          IF ReadBackwards THEN _
  456.             FOR WasI = LinesInDesc TO 1 STEP -1 : _
  457.                GOSUB 20732 : _
  458.             NEXT
  459.       PRINT #2,USING "\           \########  &  &"; _
  460.                      ZFileNameHold$; _
  461.                      ZBytesInFile#; _
  462.                      ZWasZ$; _
  463.                      ZUserIn$
  464.       IF ZGetExtDesc THEN _
  465.          IF NOT ReadBackwards THEN _
  466.             FOR WasI = 1 TO LinesInDesc : _
  467.                GOSUB 20732 : _
  468.             NEXT
  469. 20731 CALL UnLockAppend
  470.       FixedLen = 0
  471.       RETURN
  472. 20732 WasX$ = ZOutTxt$(WasI)
  473.       CALL Trim (WasX$)
  474.       IF WasX$ = "" THEN _
  475.          RETURN
  476.       IF NOT FMSFormat THEN _
  477.          PRINT #2,"  ";ZOutTxt$(WasI) : _
  478.          RETURN
  479.       IF FixedLen > LEN(ZOutTxt$(WasI)) THEN _
  480.          WasX$ = SPACE$(FixedLen - 1 - LEN(ZOutTxt$(WasI))) + "." _
  481.       ELSE WasX$ = ""
  482.       PRINT #2, "  ";LEFT$(ZOutTxt$(WasI),FixedLen);WasX$
  483.       RETURN
  484. 20734 CALL FindIt (ZFileName$)
  485. 20736 IF NOT ZOK THEN _
  486.          ZBytesInFile# = 0.0_
  487.       ELSE ZBytesInFile# = LOF(2)
  488.       IF ZBytesInFile# < 2.0 THEN _
  489.          EXIT SUB
  490.       RETURN
  491.       END SUB
  492. 20741 ' $SUBTITLE: 'BadFile - subroutine to find bad file names'
  493. ' $PAGE
  494. '
  495. '  NAME    -- BadFile
  496. '
  497. '  INPUTS  --     PARAMETER                    MEANING
  498. '               ZViolation$
  499. '               ZViolationsThisSession
  500. '               FilName$                      NAME OF FILE
  501. '
  502. '  OUTPUTS -- Result                      1 = FILE NAME IS OK
  503. '                                         2 = CHARACTER NOT ALLOWED
  504. '                                         3 = SYSTEM CRASH ATTEMPT
  505. '             ZViolationsThisSession     NUMBER OF VIOLATIONS
  506. '             FilName$                    Gets capitalized
  507. '
  508. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  509. '             to either crash the system or to breach RBBS-PC's security.
  510. '
  511.       SUB BadFile (FilName$,Result) STATIC
  512. '
  513. '
  514. ' *  TEST FOR INVALID CHARACTERS IN FILENAME
  515. '
  516. '
  517.       Result = 2
  518.       IF LEN(FilName$) < 1 THEN _
  519.          EXIT SUB
  520.       CALL BadFileChar (FilName$,ZOK)
  521.       IF NOT ZOK THEN _
  522.          EXIT SUB
  523.       CALL AllCaps (FilName$)
  524.       WasXX = INSTR(FilName$,".")
  525.       IF WasXX > 0 THEN _
  526.          IF WasXX < LEN(FilName$) THEN _
  527.             WasXX = INSTR(WasXX + 1,FilName$,".") : _
  528.             IF WasXX > 0 THEN _
  529.                EXIT SUB
  530.       WasXX = LEN(FilName$)
  531.       IF WasXX => 3 THEN _
  532.          IF INSTR("PRN:CON:AUX:NUL:",FilName$) THEN _
  533.             GOTO 20742
  534.       IF WasXX => 4 THEN _
  535.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FilName$) THEN _
  536.             GOTO 20742
  537.       CALL BreakFileName (FilName$,Pre$,Body$,Ext$,ZFalse)
  538.       IF LEN(Pre$) > 64 OR LEN(Body$) > 8 OR LEN(Body$) < 1 OR LEN(Ext$) > 3 THEN _
  539.          EXIT SUB
  540.       WasXX = LEN(Body$)
  541.       IF WasXX => 3 THEN _
  542.          IF INSTR("PRN:CON:AUX:NUL:",Body$) THEN _
  543.             GOTO 20742
  544.       IF WasXX => 4 THEN _
  545.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",Body$) THEN _
  546.             GOTO 20742
  547.       Result = 1
  548.       EXIT SUB
  549. 20742 ZViolationsThisSession = ZMaxViolations
  550.       ZViolation$ = ZViolation$ + _
  551.                    FilName$
  552.       Result = 3
  553.       END SUB
  554. '
  555. 21105 ' $SUBTITLE: 'Library - sub to support Library downloads'
  556. ' $PAGE
  557. '
  558. '  NAME    -- Library
  559. '
  560. '  INPUTS  --     PARAMETER                    MEANING
  561. '              ZSubParm                 1 = DISPLAY ACTIVE AREA
  562. '                                       2 = CHANGE ACTIVE AREA
  563. '                                       3 = DISPLAY PC-SIG
  564. '                                           DISCLAIMER
  565. '                                       4 = ARCHIVE Library DISK
  566. '                                       5 = DOWNLOAD COMPLETED
  567. '              ZLibType                 0 = No Library ACTIVE
  568. '                                       1 = Library FROM PC-SIG
  569. '              ZLibDrive$                   Library DRIVE ID
  570. '
  571. '  OUTPUTS -- NONE
  572. '
  573. '  PURPOSE -- To provide access support for library drives
  574. '
  575.       SUB Library STATIC
  576.       STATIC LibSubdirName$(1)
  577.       STATIC DiskTitle$
  578.       ZErrCode = 0
  579.       IF ZLibType = 0 THEN _
  580.          EXIT SUB
  581.       IF ZLibDiskChar$ = "" THEN _
  582.          ZLibDiskChar$ = "0000"
  583.       ON ZSubParm GOTO 21110, 21115, 21130, 21140, 21159
  584. 21110 IF ZLibDiskChar$ = "0000" THEN _
  585.          ZOutTxt$ = "No Library disk currently selected" _
  586.       ELSE ZOutTxt$ = "Library disk " + _
  587.                 ZLibDiskChar$ + _
  588.                 " selected - " + _
  589.                 DiskTitle$
  590.       CALL QuickTPut1 (ZOutTxt$)
  591.       IF LibDiskArc$ = "" THEN _
  592.          EXIT SUB
  593.       IF INSTR(ZLibArcProgram$,"ARC") THEN _                         ' KG080401
  594.          Extension$ = "ARC" _
  595.       ELSE IF INSTR(ZLibArcProgram$,"ZIP") THEN _                    ' KG080401
  596.          Extension$ = "ZIP" _
  597.       ELSE IF INSTR(ZLibArcProgram$,"LHA") THEN _                    ' KG080401
  598.          Extension$ = "LHZ" _
  599.       ELSE Extension$ = ZDefaultExtension$
  600.       FOR LibDisplayCount = 0 TO LibLoopCount - 1
  601.          IF LibSubdirName$(LibDisplayCount) <> "" THEN _
  602.             CALL QuickTPut1 (LibSubdirName$(LibDisplayCount) + _
  603.                        "." + Extension$ + " ready for transmission!")
  604.       NEXT
  605.       EXIT SUB
  606. 21115 IF ZWasQ = 1 THEN _
  607.          ZOutTxt$ = "Change Library disk from " + _
  608.               ZLibDiskChar$ + _
  609.               " to (1 -" + _
  610.               STR$(ZLibMaxDisk) + _
  611.               ")" : _
  612.          ZSubParm = 1 : _
  613.          CALL TGet : _
  614.          IF ZSubParm = -1 THEN _
  615.             EXIT SUB _
  616.          ELSE IF ZWasQ = 0 THEN _
  617.                  ZLibDiskChar$ = "0000" : _
  618.                  ChdirLib$ = ZLibDrive$ + _
  619.                                   "\" : _
  620.                  GOTO 21126
  621. 21117 IF VAL(ZUserIn$(ZWasQ)) < 1 OR VAL(ZUserIn$(ZWasQ)) > ZLibMaxDisk THEN _
  622.          ZWasQ = 1 : _
  623.          GOTO 21115
  624. 21120 ZLibDiskChar$ = ZUserIn$(ZWasQ)
  625.       CLOSE 2
  626.       ZLibDiskChar$ = RIGHT$("0000" + ZLibDiskChar$,4)
  627. 21121 CALL FindIt("RBBS-CDR.DEF")
  628.       IF NOT ZOK THEN _
  629.          EXIT SUB
  630. 21122 IF EOF(2) THEN _
  631.          ZLibDiskChar$ = "" : _
  632.          EXIT SUB
  633.       INPUT #2,WorkSubdir$,ChdirLib$
  634.       LINE INPUT #2,DiskTitle$
  635.       IF ZLibDiskChar$ = WorkSubdir$ THEN _
  636.          ChdirLib$ = ZLibDrive$ + _
  637.                           ChdirLib$ : _
  638.          GOTO 21126
  639.       GOTO 21122
  640. 21126 ZErrCode = 0
  641.       CALL ChangeDir (ChdirLib$)
  642.       IF ZErrCode <> 0 THEN _
  643.          ZLibDiskChar$ = "0000" : _
  644.          ChdirLib$ = ZLibDrive$ + _
  645.                           "\" : _
  646.          GOTO 21126
  647.       EXIT SUB
  648. 21130 IF ZLibType <> 1 THEN _
  649.          EXIT SUB
  650.       CALL SkipLine(1)
  651.       ZOutTxt$ = "The PC-SIG Library file that you are about to"     ' KG080401
  652.       CALL QuickTPut1 (ZOutTxt$)
  653.       ZOutTxt$ = "download can also be ordered as DISK " + _
  654.            ZLibDiskChar$
  655.       CALL QuickTPut1 (ZOutTxt$)
  656.       ZOutTxt$ = "from PC-SIG, 1030D East Duane Ave. Sunnyvale, Ca. 94086"
  657.       CALL QuickTPut (ZOutTxt$,2)
  658.       EXIT SUB
  659. 21140 IF ZLibDiskChar$ = "0000" THEN _
  660.          CALL QuickTPut1 ("First select a Library disk!") : _
  661.          EXIT SUB
  662.       ZOutTxt$ = "Archive files in Library disk - " + _
  663.            ZLibDiskChar$ + _
  664.            " for download (Y/[N])"
  665.       ZSubParm = 1
  666.       CALL TGet
  667.       IF NOT ZLocalUser THEN _
  668.          IF ZSubParm = -1 THEN _
  669.             EXIT SUB
  670.       IF NOT ZYes THEN _
  671.          EXIT SUB
  672. 21145 CALL KillWork (ZLibWorkDiskPath$ + _
  673.                     ZLibNodeID$ + _
  674.                     "DK*." + Extension$)
  675. 21150 CALL QuickTPut1 ("Work/RAM disk purged")
  676.       CALL QuickTPut1 ("Archiving with " + _
  677.                   ZLibArcProgram$ + _
  678.                   " Please be patient!")
  679.       REDIM LibSubdirName$(10)
  680.       LibSubdirChar$ = ""
  681.       LibLoopCount = 0
  682.       GOSUB 21157
  683.       ZOutTxt$ = "Contents of Library disk - " + _
  684.            ZLibDiskChar$ + _
  685.            " now archived for download"
  686.       CALL QuickTPut1 (ZOutTxt$)
  687.       ZOutTxt$ = "Searching for Sub-directories"
  688.       CALL QuickTPut1 (ZOutTxt$)
  689.       GOSUB 21158
  690.       LibDiskArc$ = ZLibDiskChar$
  691. '
  692. ' SEARCH AND ARCHIVE ANY SUBDIRECTORIES
  693. '
  694.       Treedir$ = ZLibWorkDiskPath$ + _
  695.                  ZLibNodeID$ + _
  696.                  "DKDIR.LST"
  697.       DirCmd$ = "DIR " + _
  698.                 ZLibDrive$ + _
  699.                 " | FIND " +  _
  700.                 CHR$(34) + _
  701.                 " <DIR> " + _
  702.                 CHR$(34) + _
  703.                 "  > " + _
  704.                 Treedir$
  705. 21151 SHELL DirCmd$
  706.       CALL SkipLine (2)
  707.       LOCATE 24,1
  708.       ZErrCode = 0
  709. 21152 CLOSE 2
  710. 21153 CALL OpenWork (2,Treedir$)
  711.       LibSubdirCount = 0
  712.       WHILE NOT EOF(2)
  713.          LINE INPUT #2, Dirrec$
  714.          IF LEFT$(Dirrec$,1) <> "." THEN _
  715.             LibSubdirCount = LibSubdirCount + 1 : _
  716.             LibSubdirName$(LibSubdirCount) = _
  717.             LEFT$(Dirrec$,8)
  718.       WEND
  719.       CLOSE 2
  720.       LibLoopCount = 1
  721.       IF LibSubdirCount = 0 THEN _
  722.          GOTO 21156
  723.       ZOutTxt$ = STR$(LibSubdirCount) + _
  724.            " Subdirectories on Library disk - " + _
  725.            ZLibDiskChar$
  726.       CALL QuickTPut1 (ZOutTxt$)
  727.       FOR LibLoopCount = 1 TO LibSubdirCount
  728.          IF NOT ZLocalUser THEN _
  729.             CALL Carrier : _
  730.             IF ZSubParm THEN _
  731.                GOTO 21155
  732.          LibSubdirChar$ = MID$("ABCDEFGHI",LibLoopCount,1)
  733.          ZOutTxt$ = "Creating " + _
  734.               ZLibNodeID$ + _
  735.               "DK" + _
  736.               ZLibDiskChar$ + _
  737.               LibSubdirChar$ + "." + Extension$ + _                  ' KG080401
  738.               " using " + ZLibArcProgram$
  739.          CALL QuickTPut1 (ZOutTxt$)
  740.          CHDIR ChdirLib$ + _
  741.                "\" + _
  742.                LibSubdirName$(LibLoopCount)
  743.          GOSUB 21157
  744.          ZOutTxt$ = "Disk - " + _
  745.               ZLibDiskChar$ + _
  746.               "; Subdirectory" + _
  747.               " -" + _
  748.               STR$(LibLoopCount) + _
  749.               " archived for download"
  750.          CALL QuickTPut1 (ZOutTxt$)
  751.          GOSUB 21158
  752. 21155 NEXT LibLoopCount
  753. 21156 CALL Carrier
  754.       ZOutTxt$ = ""
  755.       EXIT SUB
  756. 21157 LibArc$ = ZLibArcPath$ + _
  757.                        ZLibArcProgram$ + _
  758.                        " " + _
  759.                        ZLibWorkDiskPath$ + _
  760.                        ZLibNodeID$ + _
  761.                        "DK" + _
  762.                        ZLibDiskChar$ + _
  763.                        LibSubdirChar$ + _
  764.                        " " + _
  765.                        ZLibDrive$ + _
  766.                        "*.*"
  767.       IF ZUseDeviceDriver$ <> "" AND ZFossil AND NOT ZLocalUser THEN _
  768.          LibArc$ = ZDiskForDos$ + _
  769.                             "COMMAND /C " + _
  770.                             LibArc$ + _
  771.                             " > " + _
  772.                             ZUseDeviceDriver$
  773.       SHELL LibArc$
  774.       CALL SkipLine (2)
  775.       LOCATE 24,1
  776.       RETURN
  777. 21158 LibSubdirName$(LibLoopCount) = ZLibNodeID$ + _
  778.                                              "DK" + _
  779.                                              ZLibDiskChar$ + _
  780.                                              LibSubdirChar$
  781.       RETURN
  782. 21159 FOR LibDisplayCount = 0 TO LibLoopCount - 1
  783.          IF LibSubdirName$(LibDisplayCount) = ZOutTxt$ THEN _
  784.             LibSubdirName$(LibDisplayCount) = ""
  785.       NEXT
  786.       END SUB
  787. 21598 ' $SUBTITLE: 'XferType - sub to identify file xfer protocol'
  788. ' $PAGE
  789. '
  790. '  NAME    -- XferType
  791. '
  792. '  INPUTS  --     PARAMETER                    MEANING
  793. '               Index            = 1       Manual select for up/download
  794. '                                = 2       Default select
  795. '                                = 3       Set transfer default
  796. '               ZOutTxt$
  797. '               ZUserIn$(1)
  798. '               ZWasQ
  799. '               ZReliableMode
  800. '               ZTransferOption$
  801. '               ZUserXferDefault$
  802. '               ZXferSupport
  803. '
  804. '  OUTPUTS   -- ZCheckSum
  805. '               ZFLen
  806. '               ZWasFT$
  807. '
  808. '  PURPOSE -- To identify the file transfer protocol (either
  809. '             from the user's default or via explicit selection)
  810. '
  811.       SUB XferType (Index,SkipHelp) STATIC
  812.       IF ZTransferOption$ = "" OR ZUserSecLevel <> PrevUSL THEN _
  813.          CALL Protocol : _
  814.          PrevUSL = ZUserSecLevel
  815.       WasX$ = ZOutTxt$ + "Protocol"
  816.       ON Index GOTO 21600,21620,21600
  817. '
  818. '
  819. ' *  MANUAL SELECT OF Transfer Protocol
  820. '
  821. '
  822. 21600 IF SkipHelp THEN _
  823.          GOTO 21604
  824. 21602 CALL BufFile (ZHelpPath$ + "UF" + ZHelpExtension$,WasX)
  825.       IF ZSubParm = -1 THEN _
  826.          EXIT SUB
  827. 21604 ZStopInterrupts = ZTrue
  828.       IF Index = 3 THEN _
  829.          IF ZAnsIndex < ZLastIndex THEN _
  830.             GOTO 21605
  831.       CALL QuickTPut1 (WasX$)
  832.       CALL BufString (ZTransferOption$,4096,WasX)
  833.       CALL QuickTPut (MID$("?!",1-ZTurboKeyUser,1)+" ",0)
  834. 21605 ZOutTxt$ = ""
  835.       ZTurboKey = -ZTurboKeyUser
  836.       ZMacroMin = 2
  837.       ZSubParm = 1
  838.       ZSuspendAutoLogoff = ZTrue
  839.       ZStackC = ZTrue
  840.       IF Index = 3 THEN _
  841.          CALL PopCmdStack : _
  842.          WasX = ZAnsIndex _
  843.       ELSE ZSubParm = 1 : _
  844.            CALL TGet : _
  845.            WasX = 1
  846.       ZSuspendAutoLogoff = ZFalse
  847.       IF ZSubParm = -1 THEN _
  848.          EXIT SUB
  849.       IF ZWasQ = 0 THEN _
  850.          GOTO 21604
  851. 21606 ZWasZ$ = ZUserIn$(WasX)
  852. '
  853. '
  854. ' *  DEFAULT SELECT OF Transfer Protocol
  855. '
  856. '
  857. 21610 CALL AllCaps (ZWasZ$)
  858.       ZFF = INSTR(ZDefaultXfer$,ZWasZ$)                              ' KG071903
  859.       IF ZFF > 0 THEN _                                              ' KG071903
  860.          GOTO 21612                                                  ' KG071903
  861.       IF INSTR("H?",ZWasZ$) > 0 THEN _                               ' KG071903
  862.          GOTO 21602                                                  ' KG071903
  863.       GOTO 21600                                                     ' KG071903
  864. 21612 ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1)
  865.       ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1)
  866.       GOTO 21621
  867. 21620 ZFF = -1
  868.       IF ZCmdTransfer$ <> "" THEN _
  869.          ZWasZ$ = ZCmdTransfer$ : _
  870.          GOTO 21610
  871.       WasX = INSTR(ZDefaultXfer$,ZUserXferDefault$)
  872.       IF WasX > 0 THEN _
  873.          IF MID$(ZInternalEquiv$,WasX,1) <> "N" THEN _
  874.             ZWasZ$ = ZUserXferDefault$ : _
  875.             GOTO 21610
  876.       ZProtoPrompt$ = "None"
  877.       ZFF = 0
  878.       EXIT SUB
  879. 21621 IF ZFF = PrevFF AND PrevProtoDef$ = ZProtoDef$ THEN _
  880.          ZProtoPrompt$ = PrevProtoPrompt$ : _
  881.          EXIT SUB
  882.       PrevFF = ZFF
  883.       PrevProtoDef$ = ZProtoDef$
  884.       ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1)
  885.       ZCheckSum = (ZInternalProt$ = "X")
  886.       CALL FindIt (ZProtoDef$)
  887.       IF ZOK THEN _
  888.          GOTO 21623
  889.       WasX = INSTR("AXCYN",ZInternalProt$)
  890.       IF WasX < 1 THEN _
  891.          ZInternalProt$ = "N"
  892.       ZProtoPrompt$ = MID$("Ascii     Xmodem    Xmodem/CRCYmodem    None",10*INSTR("AXCYN",ZInternalProt$)-9,10)
  893.       CALL TrimTrail (ZProtoPrompt$," ")
  894.       ZCheckSum = (ZInternalProt$ = "X")
  895.       ZFLen = 128 - 896 * (ZInternalProt$ = "Y")
  896.       ZBlockSize = ZFLen
  897.       IF ZInternalProt$ = "Y" THEN _
  898.          ZSpeedFactor! = 0.87 _
  899.       ELSE IF ZInternalProt$ = "A" THEN _
  900.          ZSpeedFactor! = 0.92 _
  901.       ELSE ZSpeedFactor! = 0.78
  902.       GOTO 21625
  903. 21623 CALL ReadParms (ZWorkAra$(),13,ZFF)
  904.       IF ZErrCode > 0 THEN _
  905.          ZFF = LEN(ZDefaultXfer$) : _
  906.          ZProtoPrompt$ = "None" : _
  907.          GOTO 21625
  908.       ZProtoPrompt$ = ZWorkAra$(1)
  909.       IF LEN(ZProtoPrompt$) > 2 THEN _
  910.          IF MID$(ZProtoPrompt$,2,1) = ")" THEN _
  911.             ZProtoPrompt$ = LEFT$(ZProtoPrompt$,1) + MID$(ZProtoPrompt$,3)
  912.       WasX = INSTR(ZProtoPrompt$+ZCrLf$,ZCrLf$)
  913.       ZProtoPrompt$ = LEFT$(ZProtoPrompt$,WasX-1)
  914.       CALL Trim (ZProtoPrompt$)
  915.       ZProtoMethod$ = LEFT$(ZWorkAra$(3),1)
  916.       CALL AllCaps (ZProtoMethod$)
  917.       ZReq8Bit = (LEFT$(ZWorkAra$(4),1) = "8")
  918.       ZDownTemplate$ = ZWorkAra$(12)
  919.       ZUpTemplate$ = ZWorkAra$(13)
  920.       WasX$ = ZWorkAra$(11)
  921.       WasX = INSTR(WasX$,"=")
  922.       ZAdvanceProtoWrite = ZFalse
  923.       IF WasX < 2 OR WasX >= LEN(WasX$) THEN _
  924.          ZFailureParm = 4 : _
  925.          ZFailureString$ = "F" _
  926.       ELSE ZFailureParm = VAL(LEFT$(WasX$,WasX-1)) : _
  927.            ZFailureString$ = MID$(WasX$,WasX+1) : _
  928.            WasX = INSTR(ZFailureString$,"=") : _
  929.            IF WasX > 0 THEN _
  930.               ZAdvanceProtoWrite = (MID$(ZFailureString$,WasX) = "=A") : _
  931.               ZFailureString$ = LEFT$(ZFailureString$,WasX-1)
  932.       ZProtoMacro$ = ZWorkAra$(10)
  933.       ZFakeXRpt = (LEFT$(ZWorkAra$(8),1) = "F")
  934.       ZBatchProto = (LEFT$(ZWorkAra$(6),1) = "B")
  935.       ZSpeedFactor! = VAL(ZWorkAra$(9))
  936.       IF ZSpeedFactor! < 0.1 THEN _
  937.          ZSpeedFactor! = 0.87
  938.       ZBlockSize = VAL(ZWorkAra$(7))
  939.       ZFLen = ZBlockSize
  940.       IF ZFLen < 1 THEN _
  941.          ZFLen = 128
  942. 21625 PrevProtoPrompt$ = ZProtoPrompt$
  943.       END SUB
  944. 21993 ' $SUBTITLE: 'FileLock - subroutine to share RBBS-PC files'
  945. ' $PAGE
  946. '
  947. '  NAME    -- FileLock
  948. '
  949. '  INPUTS  --     PARAMETER                    MEANING
  950. '             ZSubParm               = 1 UNLOCK USERS AND MESSAGES
  951. '                                      2 FLUSH MESSAGE RECORD TO DISK
  952. '                                        AND UNLOCK MESSAGES
  953. '                                      3 LOCK MESSAGE FILE
  954. '                                      4 UNLOCK MESSAGE FILE
  955. '                                      5 LOCK USER FILE
  956. '                                      6 LOCK 4 RECORD BLOCK IN USER
  957. '                                        FILE
  958. '                                      7 UNLOCK USER FILE
  959. '                                      8 UNLOCK 4 RECORD BLOCK IN USER
  960. '                                        FILE
  961. '                                      9 LOCK UPLOAD DIRECTORY OR
  962. '                                        COMMENTS FILE
  963. '                                     10 UNLOCK UPLOAD DIRECTORY OR
  964. '                                        COMMENTS FILE
  965. '               ACTIVE.MESSAGE FILE$     NAME OF MESSAGE FILE
  966. '               ZActiveUserFile$         NAME OF USER FILE
  967. '               CONFIG.FILE.NAME$        FILE NAME TO FLUSH RECORD FROM
  968. '               ZWasEN$                  UPLOAD DIRECTORY OR COMMENTS
  969. '                                        FILE NAME TO LOCK/UNLOCK
  970. '               ZNetworkType             TYPE OF NETWORK LOCKING TO USE
  971. '
  972. '  OUTPUTS -- ZSubParm = -1 TERMINATE RBBS-PC IMMEDATELY
  973. '             ZBlk
  974. '             ZLockDrive
  975. '             ZLockFileName$
  976. '             ZLockStatus$
  977. '             ZMsgFileLock
  978. '             ZUserBlockLock
  979. '             ZUserFileLock
  980. '             ZUserFileIndex
  981. '
  982. '  PURPOSE -- To lock and unlock the shared RBBS-PC files when
  983. '             multiple copies of RBBS-PC are sharing the same
  984. '             files in either a multi-tasking DOS environment or
  985. '             in a local area network environment
  986. '
  987.       SUB FileLock STATIC
  988.       ON ZSubParm GOSUB 21995,21996,22000,25000,26000, _
  989.                                     26500,27000,27500,29000,29500
  990.       EXIT SUB
  991. '
  992. '
  993. ' *  UNLOCK USERS AND MESSAGES
  994. '
  995. '
  996. 21995 GOSUB 27000
  997.       GOSUB 25000
  998.       RETURN
  999. '
  1000. '
  1001. ' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1
  1002. '
  1003. '
  1004. 21996 CLOSE 1
  1005.       IF ZShareIt THEN _
  1006.          OPEN ZConfigFileName$ FOR INPUT SHARED AS #1 _
  1007.       ELSE OPEN "I",1,ZConfigFileName$
  1008. '
  1009. '
  1010. ' *  UNLOCK MESSAGES
  1011. '
  1012. '
  1013.       GOSUB 25000
  1014.       CALL OpenMsg
  1015.       RETURN
  1016. '
  1017. '
  1018. ' *  LOCK MESSAGE FILE
  1019. '
  1020. '
  1021. 22000 IF ZMsgFileLock = ZTrue THEN _
  1022.          RETURN
  1023.       ZMsgFileLock = ZTrue
  1024.       MID$(ZLockStatus$,1,2) = "LM"
  1025.       ZSubParm = 2
  1026.       CALL Line25
  1027.       ZLockFileName$ = ZActiveMessageFile$
  1028.       ON ZNetworkType GOTO 22100,22200,22300,22400,22500,29700
  1029.       RETURN
  1030. '
  1031. '
  1032. ' *  LOCK MESSAGE FILE (MULTI-LINK)
  1033. '
  1034. '
  1035. 22100 WasAX = &H0
  1036.       WasBX = &H1
  1037.       IF ZMultiLinkPresent > 0 THEN _
  1038.          CALL RBBSML(WasAX,WasBX)
  1039.       RETURN
  1040. '
  1041. '
  1042. ' *  LOCK MESSAGE FILE (OMNINET)
  1043. '
  1044. '
  1045. 22200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
  1046.       WasCC$ = CHR$(1) + _
  1047.             LEFT$(Prefix$ + SPACE$(8),8)
  1048.       GOSUB 28000
  1049.       IF WasCT = 0 THEN _
  1050.          RETURN
  1051.       CALL DelayTime (1)
  1052.       GOTO 22200
  1053. '
  1054. '
  1055. ' *  LOCK MESSAGE FILE (ORCHID PC-NET)
  1056. ' *  LOCK USER FILE (ORCHID PC-NET)
  1057. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
  1058. '
  1059. '
  1060. 22300 GOSUB 28100
  1061.       CALL LPLKIT(ZLockDrive,ZLockFileName$,ZWasA)
  1062.       RETURN
  1063. '
  1064. '
  1065. ' *  LOCK SYSTEM (DESQview)
  1066. '
  1067. '
  1068. 22400 CALL DVLock("MESSAGE")
  1069.       RETURN
  1070. '
  1071. '
  1072. ' *  LOCK MESSAGE FILE (10 NET)
  1073. ' *  LOCK USER FILE (10 NET)
  1074. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
  1075. '
  1076. '
  1077. 22500 GOSUB 28100
  1078.       CALL LPLK10(ZLockDrive,ZLockFileName$,ZWasA)
  1079.       RETURN
  1080. '
  1081. '
  1082. ' *  UNLOCK MESSAGE FILE
  1083. '
  1084. '
  1085. 25000 IF NOT ZMsgFileLock THEN _
  1086.          RETURN
  1087.       ZMsgFileLock = ZFalse
  1088.       MID$(ZLockStatus$,1,2) = "UM"
  1089.       ZSubParm = 2
  1090.       CALL Line25
  1091.       ZLockFileName$ = ZActiveMessageFile$
  1092.       ON ZNetworkType GOTO 25100,25200,25300,25400,25500,29800
  1093.       RETURN
  1094. '
  1095. '
  1096. ' *  UNLOCK MESSAGE FILE (MULTI-LINK)
  1097. '
  1098. '
  1099. 25100 WasAX = &H100
  1100.       WasBX = &H1
  1101.       IF ZMultiLinkPresent > 0 THEN _
  1102.          CALL RBBSML(WasAX,WasBX)
  1103.       RETURN
  1104. '
  1105. '
  1106. ' *  UNLOCK MESSAGE FILE (OMNINET)
  1107. '
  1108. '
  1109. 25200 CALL BreakFileName (ZActiveMessageFile$,Drive$,Prefix$,Ext$,ZFalse)
  1110.       WasCC$ = CHR$(17) + _
  1111.             LEFT$(Prefix$ + SPACE$(8),8)
  1112.       GOSUB 28000
  1113.       IF WasCT = 128 THEN _
  1114.          RETURN
  1115.       CALL DelayTime (1)
  1116.       GOTO 25200
  1117. '
  1118. '
  1119. ' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)
  1120. ' *  UNLOCK USER FILE (ORCHID PC-NET)
  1121. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (ORCHID PC-NET)
  1122. '
  1123. '
  1124. 25300 GOSUB 28100
  1125.       CALL UNLOKIT(ZLockDrive,ZLockFileName$,ZWasA)
  1126.       RETURN
  1127. '
  1128. '
  1129. ' *  UNLOCK MESSAGE FILE (DESQVIEW)
  1130. '
  1131. '
  1132. 25400 CALL DVUnlock("MESSAGE")
  1133.       RETURN
  1134. '
  1135. '
  1136. ' *  UNLOCK MESSAGE FILE (10 NET)
  1137. ' *  UNLOCK USER FILE (10 NET)
  1138. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (10 NET)
  1139. '
  1140. '
  1141. 25500 GOSUB 28100
  1142.       CALL UNLOK10(ZLockDrive,ZLockFileName$,ZWasA)
  1143.       RETURN
  1144.  
  1145. '
  1146. '
  1147. ' *  LOCK USER FILE
  1148. '
  1149. '
  1150. 26000 IF ZUserFileLock = ZTrue THEN _
  1151.          RETURN
  1152.       ZUserFileLock = ZTrue
  1153.       MID$(ZLockStatus$,4,2) = "LU"
  1154.       ZSubParm = 2
  1155.       CALL Line25
  1156.       ZLockFileName$ = ZActiveUserFile$
  1157.       ON ZNetworkType GOTO 26100,26200,22300,26300,22500,29720
  1158.       RETURN
  1159. '
  1160. '
  1161. ' *  LOCK USER FILE (MULTI-LINK)
  1162. '
  1163. '
  1164. 26100 WasAX = &H0
  1165.       WasBX = &H2
  1166.       IF ZMultiLinkPresent > 0 THEN _
  1167.          CALL RBBSML(WasAX,WasBX)
  1168.       RETURN
  1169. '
  1170. '
  1171. ' *  LOCK USER FILE (OMNINET)
  1172. '
  1173. '
  1174. 26200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
  1175.       WasCC$ = CHR$(1) + _
  1176.             LEFT$(Prefix$ + SPACE$(8),8)
  1177.       GOSUB 28000
  1178.       IF WasCT = 0 THEN _
  1179.          RETURN
  1180.       CALL DelayTime (1)
  1181.       GOTO 26200
  1182. '
  1183. '
  1184. ' *  LOCK USER FILE (DESQVIEW)
  1185. '
  1186. '
  1187. 26300 CALL DVLock("USER")
  1188.       RETURN
  1189. '
  1190. '
  1191. ' *  LOCK 4 RECORD BLOCK IN USER FILE
  1192. '
  1193. '
  1194. 26500 IF ZUserBlockLock = ZTrue THEN _
  1195.          RETURN
  1196.       ZUserBlockLock = ZTrue
  1197.       ZBlk = (ZUserFileIndex / 4) + .26
  1198.       MID$(ZLockStatus$,7,2) = "LB"
  1199.       ZSubParm = 2
  1200.       CALL Line25
  1201.       ON ZNetworkType GOTO 26600,26700,26800,26750,26900,29730
  1202.       RETURN
  1203. '
  1204. '
  1205. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1206. '
  1207. '
  1208. 26600 WasAX = &H0
  1209.       WasBX = ZBlk + 10
  1210.       IF ZMultiLinkPresent > 0 THEN _
  1211.          CALL RBBSML(WasAX,WasBX)
  1212.       RETURN
  1213. '
  1214. '
  1215. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1216. '
  1217. '
  1218. 26700 WasCC$ = CHR$(1) + _
  1219.             "BLK" + _
  1220.             RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1221.       GOSUB 28000
  1222.       IF WasCT = 0 THEN _
  1223.          RETURN
  1224.       CALL DelayTime (1)
  1225.       GOTO 26700
  1226. '
  1227. '
  1228. ' *  LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW)
  1229. '
  1230. '
  1231. 26750 CALL DVLock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
  1232.       RETURN
  1233. '
  1234. '
  1235. ' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1236. '
  1237. '
  1238. 26800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1239.                         "BLK" + _
  1240.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1241.       GOTO 22300
  1242. '
  1243. '
  1244. ' *  LOCK 4 RECORD BLOCK IN USER FILE (10 NET)
  1245. '
  1246. '
  1247. 26900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1248.                         "BLK" + _
  1249.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1250.       GOTO 22500
  1251. '
  1252. '
  1253. ' *  UNLOCK USER FILE
  1254. '
  1255. '
  1256. 27000 IF NOT ZUserFileLock THEN _
  1257.          RETURN
  1258.       ZUserFileLock = ZFalse
  1259.       MID$(ZLockStatus$,4,2) = "UU"
  1260.       ZSubParm = 2
  1261.       CALL Line25
  1262.       ZLockFileName$ = ZActiveUserFile$
  1263.       ON ZNetworkType GOTO 27100,27200,25300,27300,25500,29820
  1264.       RETURN
  1265. '
  1266. '
  1267. ' *  UNLOCK USER FILE (MULTI-LINK)
  1268. '
  1269. '
  1270. 27100 WasAX = &H100
  1271.       WasBX = &H2
  1272.       IF ZMultiLinkPresent > 0 THEN _
  1273.          CALL RBBSML(WasAX,WasBX)
  1274.       RETURN
  1275. '
  1276. '
  1277. ' *  UNLOCK USER FILE (OMNINET)
  1278. '
  1279. '
  1280. 27200 CALL BreakFileName (ZActiveUserFile$,Drive$,Prefix$,Ext$,ZFalse)
  1281.       WasCC$ = CHR$(17) + _
  1282.             LEFT$(Prefix$ + SPACE$(8),8)
  1283.       GOSUB 28000
  1284.       IF WasCT = 128 THEN _
  1285.          RETURN
  1286.       CALL DelayTime (1)
  1287.       GOTO 27200
  1288. '
  1289. '
  1290. ' *  UNLOCK USER FILE (DESQVIEW)
  1291. '
  1292. '
  1293. 27300 CALL DVUnlock("USER")
  1294.       RETURN
  1295. '
  1296. '
  1297. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE
  1298. '
  1299. '
  1300. 27500 IF NOT ZUserBlockLock THEN _
  1301.          RETURN
  1302.       ZUserBlockLock = ZFalse
  1303.       ZBlk = (ZUserFileIndex / 4) + .26
  1304.       MID$(ZLockStatus$,7,2) = "UB"
  1305.       ZSubParm = 2
  1306.       CALL Line25
  1307.       ON ZNetworkType GOTO 27600,27700,27800,27750,27900,29830
  1308.       RETURN
  1309. '
  1310. '
  1311. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)
  1312. '
  1313. '
  1314. 27600 WasAX = &H100
  1315.       WasBX = ZBlk + 10
  1316.       IF ZMultiLinkPresent > 0 THEN _
  1317.          CALL RBBSML(WasAX,WasBX)
  1318.       RETURN
  1319. '
  1320. '
  1321. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)
  1322. '
  1323. '
  1324. 27700 WasCC$ = CHR$(17) + _
  1325.             "BLK" + _
  1326.             RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1327.       GOSUB 28000
  1328.       IF WasCT = 128 THEN _
  1329.          RETURN
  1330.       CALL DelayTime (1)
  1331.       GOTO 27700
  1332. '
  1333. '
  1334. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW)
  1335. '
  1336. '
  1337. 27750 CALL DVUnlock("BLK" + RIGHT$("0000" + MID$(STR$(ZBlk),2),5))
  1338.       RETURN
  1339. '
  1340. '
  1341. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)
  1342. '
  1343. '
  1344. 27800 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1345.                         "BLK" + _
  1346.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1347.       GOTO 25300
  1348. '
  1349. '
  1350. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (10-NET)
  1351. '
  1352. '
  1353. 27900 ZLockFileName$ = LEFT$(ZActiveUserFile$,2) + _
  1354.                         "BLK" + _
  1355.                         RIGHT$("0000" + MID$(STR$(ZBlk),2),5)
  1356.       GOTO 25500
  1357. '
  1358. '
  1359. ' *  CORVUS OMNINET INTERFACE
  1360. '
  1361. '
  1362. 28000 WasCC$ = ZLineFeed$ + _
  1363.             CHR$(0) + _
  1364.             CHR$(11) + _
  1365.             WasCC$
  1366.       CALL CDSend(WasCC$)
  1367.       CALL CDRecv(ZWasCN$)
  1368.       WasCT = ASC(MID$(ZWasCN$,3,1))
  1369.       IF WasCT => 128 THEN _
  1370.          CALL LPrnt("CORVUS LOCK FAIL",1) : _
  1371.          ZSubParm = -1
  1372. 28010 WasCT = ASC(MID$(ZWasCN$,4,1))
  1373.       IF WasCT => 129 THEN _
  1374.          CALL LPrnt("CORVUS FULL",1) : _
  1375.          ZSubParm = -1
  1376.       RETURN
  1377. '
  1378. '
  1379. ' *  ORCHID PC-NET & 10 NET INTERFACE
  1380. '
  1381. '
  1382. 28100 CALL AllCaps (ZLockFileName$)
  1383.       ZLockDrive = ASC(LEFT$(ZLockFileName$,1)) - ASC("A")
  1384.       ZLockFileName$ = ZLockFileName$ + _
  1385.                         STRING$(32 - LEN(ZLockFileName$),0)
  1386.       ZWasA = 0
  1387.       RETURN
  1388. '
  1389. '
  1390. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
  1391. '
  1392. '
  1393. 29000 IF LockedEn$ = ZWasEN$ THEN _
  1394.          RETURN
  1395.       LockedEn$ = ZWasEN$
  1396.       MID$(ZLockStatus$,10,2) = "LD"
  1397.       ZSubParm = 2
  1398.       CALL Line25
  1399.       ZLockFileName$ = ZWasEN$
  1400.       ON ZNetworkType GOTO 29100,29010,22300,29300,22500,29710
  1401. 29010 RETURN
  1402. '
  1403. '
  1404. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
  1405. '
  1406. '
  1407. 29100 WasAX = &H0
  1408.       WasBX = &H3
  1409.       IF ZMultiLinkPresent > 0 THEN _
  1410.          CALL RBBSML(WasAX,WasBX)
  1411.       RETURN
  1412. '
  1413. '
  1414. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1415. '
  1416. '
  1417. 29300 CALL DVLock("MISC")
  1418.       RETURN
  1419. '
  1420. '
  1421. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$
  1422. '
  1423. '
  1424. 29500 IF LockedEn$ <> ZWasEN$ THEN _
  1425.          RETURN
  1426.       LockedEn$ = ""
  1427.       MID$(ZLockStatus$,10,2) = "UD"
  1428.       ZSubParm = 2
  1429.       CALL Line25
  1430.       ZLockFileName$ = ZWasEN$
  1431.       ON ZNetworkType GOTO 29600,29510,25300,29650,25500,29810
  1432. 29510 RETURN
  1433. '
  1434. '
  1435. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON ZWasEN$ (MULTI-LINK)
  1436. '
  1437. '
  1438. 29600 WasAX = &H100
  1439.       WasBX = &H3
  1440.       IF ZMultiLinkPresent > 0 THEN _
  1441.          CALL RBBSML(WasAX,WasBX)
  1442.       EXIT SUB
  1443. '
  1444. '
  1445. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)
  1446. '
  1447. '
  1448. 29650 CALL DVUnlock("MISC")
  1449.       RETURN
  1450. '
  1451. '
  1452. ' *  NetBIOS SEMAPHORE LOCK MECHANISM
  1453. ' *     Only the USERS file is actually locked.  All other files are locked
  1454. ' *     by means of the semaphore file IBMFLAGS.  Each IBMFLAGS record is a
  1455. ' *     file semaphore as follows:
  1456. ' *        RECORD 1 = MESSAGES file lock status
  1457. ' *        RECORD 2 = Comments/Upload dir locked
  1458. ' *        RECORD 3 = entire USERS file lock
  1459. '
  1460. '
  1461. ' * Lock MESSAGES
  1462. 29700 CALL NetBIOS (1,6,1)
  1463.       RETURN
  1464.  
  1465. ' * Lock Comments/Upload dir
  1466. 29710 CALL NetBIOS (1,6,2)
  1467.       RETURN
  1468.  
  1469. ' * Lock USERS file
  1470. 29720 CALL NetBIOS (1,6,3)
  1471.       RETURN
  1472.  
  1473. ' * Lock single USERS record
  1474. 29730 CALL NetBIOS (1,6,3)
  1475.       RETURN
  1476.  
  1477. ' * UNLOCK MESSAGES
  1478. 29800 CALL NetBIOS (0,6,1)
  1479.       RETURN
  1480.  
  1481. ' * UNLOCK Comments/Upload dir
  1482. 29810 CALL NetBIOS (0,6,2)
  1483.       RETURN
  1484.  
  1485. ' * UNLOCK USERS file
  1486. 29820 CALL NetBIOS (0,6,3)
  1487.       RETURN
  1488.  
  1489. ' * UNLOCK single USERS record
  1490. 29830 CALL NetBIOS (0,6,3)
  1491.       RETURN
  1492.       END SUB
  1493. 30000 ' $SUBTITLE: 'InitIBM - sub to create/open NetBIOS semaphore file'
  1494. ' $PAGE
  1495. '
  1496. '  NAME    -- InitIBM   (Written by Doug Azzarito)
  1497. '
  1498. '  INPUTS  -- NONE
  1499. '
  1500. '  OUTPUTS -- ZSubParm = -1   Abort RBBS
  1501. '
  1502. '  PURPOSE -- Open semaphore file "IBMFLAGS" on default drive as file #6
  1503. '             Create file if it does not exits.
  1504. '
  1505.       SUB InitIBM STATIC
  1506. '
  1507. '
  1508. ' *  SEE IF FILE EXISTS
  1509. '
  1510. '
  1511.       ZShareIt = ZTrue
  1512.       CALL BreakFileName (ZMainMsgFile$,IBMFlagFile$,Dummy$,Dummy$,ZTrue)
  1513.       IBMFlagFile$ = IBMFlagFile$ + _
  1514.                        "IBMFLAGS"
  1515.       CALL FindIt (IBMFlagFile$)
  1516.       CLOSE 2
  1517.       IF ZOK THEN _
  1518.          GOTO 30020
  1519. '
  1520. '
  1521. ' *  CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE
  1522. '
  1523. '
  1524.       OPEN IBMFlagFile$ ACCESS WRITE AS #6 LEN=2
  1525.       FIELD 6, 2 AS LockBuf$
  1526.       LSET LockBuf$ = MKI$(0)
  1527.       FOR WasI = 1 TO 3
  1528.          PUT 6
  1529.       NEXT
  1530.       CLOSE #6
  1531. 30020 OPEN IBMFlagFile$ ACCESS READ WRITE SHARED AS #6 LEN=2
  1532.       END SUB
  1533. 30500 ' $SUBTITLE: 'OpenMsg - open the MESSAGES file'
  1534. ' $PAGE
  1535. '
  1536. '  NAME    -- OpenMsg
  1537. '
  1538. '  INPUTS  --     PARAMETER                    MEANING
  1539. '              ZActiveMessageFile$
  1540. '              ZShareIt
  1541. '
  1542. '  OUTPUTS --  ZMsgRec$
  1543. '
  1544.       SUB OpenMsg STATIC
  1545. '
  1546. '
  1547. ' *  OPEN AND DEFINE MESSAGE FILE
  1548. '
  1549. '
  1550.      CLOSE 1
  1551.       IF ZShareIt THEN _
  1552.          OPEN ZActiveMessageFile$ ACCESS READ WRITE SHARED AS #1 _
  1553.       ELSE OPEN "R",1,ZActiveMessageFile$
  1554.       FIELD 1,128 AS ZMsgRec$
  1555.       END SUB
  1556. 30595 ' $SUBTITLE: 'FindFKey - sub to handle local keyboard functions'
  1557. ' $PAGE
  1558. '
  1559. '  NAME    -- FindFKey
  1560. '
  1561. '  INPUTS  --  PARAMETER                 MEANING
  1562. '             ZActiveMenu$              INDICATOR OF ACTIVE MENU
  1563. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1564. '             ZAutoDownDesired          USER'S PREFERENCE FOR AUTODOWNLOADING
  1565. '             ZCallersFile$             NAME OF CALLERS FILE
  1566. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1567. '             ZCheckBulletLogon         USER'S PREFERENCE FOR BULLETIN CHECK
  1568. '             ZConfMode                 INDICATOR THAT USER IS IN A CONFERENCE
  1569. '             ZCursorLine               LINE THAT THE CURSOR IS AT
  1570. '             ZCursorRow                ROW THAT THE CURSOR IS AT
  1571. '             ZDiskForDos$              DISK TO LOAD COMMAND.COM FROM
  1572. '             ZDiskFullGoOffline        INDICATOR OF WHAT TO DO WHEN DISK FULL
  1573. '             ZExitToDoors              FLAG INDICATING EXITING TO DOORS
  1574. '             ZExpertUser               FLAG FOR EXPERT/NOVICE USER MODE
  1575. '             ZFirstName$               LOGGED ON USER'S First NAME
  1576. '             ZF1Key                    FUNCTION KEY ONE VALUE
  1577. '             ZF10Key                   FUNCTION KEY TEN VALUE
  1578. '             ZWasGR                    GRAPHICS PREFERENCE OF USER
  1579. '             ZLineFeeds                SWTICH FOR USER'S LINE FEED PREFERENCE
  1580. '             ZLocalUser                FLAG INDICATING USER IS LOCAL
  1581. '             ZMinLogonSec              MINIMUM SECURITY TO LOGON
  1582. '             ZModemGoOffHookCmd$       COMMAND TO TAKE MODEM OFF-HOOK
  1583. '             ZModemInitBaud$           BAUD TO INITIALIZE MODEM AT
  1584. '             ZNodeID$                  NODE IDENTIFIER
  1585. '             ZNodeRecIndex             NODE RECORD Index FOR THIS NODE
  1586. '             ZNulls                    Switch FOR USER'S PREFERENCE FOR Nulls
  1587. '             ZPrinter                  Toggle INDICATING Printer IS AVAILABLE
  1588. '             ZPromptBell               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1589. '             SECONDS.PER.SESSION       TIME LEFT IN CURRENT USER SESSION
  1590. '             ZSkipFilesLogon           USER'S LOGON NOTIFICIATION PREFERENCE
  1591. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1592. '             ZSubParm                  -8  = Sysop'S OPTION 6 REMOTELY
  1593. '                                       -9  = GOT TO DOS
  1594. '                                       -10 = Sysop GET'S SYSTEM NEXT
  1595. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1596. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1597. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1598. '             ZUpperCase                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1599. '             ZUserFileIndex            Index INTO THE USER FILE FOR CALLER
  1600. '             ZUserSecLevel             USER'S SECURITY LEVEL
  1601. '             USERT.TRANSFER.DEFAULT    USER'S FILE Transfer DEFAULT PREFERENCE
  1602. '
  1603. '  OUTPUTS --
  1604. '             ZAdjustedSecurity         Switch INDICATING TEMP. SECURITY CHANGE
  1605. '             ZChatAvail                Toggle INDICATING IF Sysop WILL CHAT
  1606. '             ZFunctionKey              VALUE 1 TO 10 CORRESPONDING TO
  1607. '                                       THE FUNCTION KEY THAT WAS PRESSED
  1608. '             ZKeyPressed$              CHARACTER STRING GENERATED BY KEY
  1609. '             ZPrinter                  TOGGLE INDICATING Printer IS AVAILABLE
  1610. '             ZSnoop                    Toggle INDICATING Snoop STATUS
  1611. '             ZSysop                    INDICATOR THAT USER IS Sysop
  1612. '             ZSysopAnnoy               Toggle INDICATING Sysop IS AVAILABLE
  1613. '             ZSysopNext                Toggle SO Sysop GETS SYSTEM NEXT
  1614. '             ZSubParm                  -1 Carrier LOST
  1615. '                                       -2 CHAT MODE ACTIVATED
  1616. '                                       -3 FORCE CALLER ON-LINE
  1617. '                                       -4 EXIT TO SYSTEM IMMEDIATELY
  1618. '                                       -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1619. '                                       -6 TELL USER ACCESS IS DENIED
  1620. '                                       -7 UPDATE CALLERS FILE AND DENY ACCESS
  1621. '             ZUserSecLevel      USER'S SECURITY LEVEL
  1622. '
  1623. '  PURPOSE -- To determine if a function has been pressed on
  1624. '             the PC'S keyboard that is running RBBS-PC.
  1625. '
  1626.       SUB FindFKey STATIC
  1627.       LookUp = ZSubParm
  1628.       IF ZSubParm < -1 THEN _
  1629.          ZSubParm = 0 : _
  1630.          IF LookUp = - 8 THEN _
  1631.             GOTO 33070 _
  1632.          ELSE IF LookUp = - 9 THEN _
  1633.                  GOTO 31000 _
  1634.               ELSE IF LookUp = - 10 THEN _
  1635.                       GOTO 33090
  1636. '
  1637. '
  1638. ' *  TEST FOR FUNCTION KEY PRESSED
  1639. '
  1640. '
  1641. 30600 IF ZKeyboardStack$ = "" THEN _
  1642.          ZKeyPressed$ = INKEY$ _
  1643.       ELSE ZKeyPressed$ = ZKeyboardStack$ : _
  1644.            ZKeyboardStack$ = ""
  1645.       ZFunctionKey = 0
  1646.       IF LEN(ZKeyPressed$) <> 2 THEN _
  1647.          GOTO 33970
  1648.       ZKeyPressed = ASC(RIGHT$(ZKeyPressed$,1))
  1649.       IF ZLocalUser AND NOT ZSysop THEN _
  1650.          ZKeyPressed$ = "" : _
  1651.          GOTO 33970
  1652.       IF ZKeyPressed => ZF1Key AND _
  1653.          ZKeyPressed <= ZF10Key THEN _
  1654.              ZFunctionKey = ZKeyPressed - 58 : _
  1655.              GOTO 30610
  1656.       IF ZKeyPressed = 117 THEN _    'Ctrl-End
  1657.          ZFunctionKey = 11
  1658.       IF ZKeyPressed = 73 THEN _     'PgUp
  1659.          ZFunctionKey = 12
  1660.       IF ZKeyPressed = 72 THEN _     'up arrow
  1661.          ZFunctionKey = 13
  1662.       IF ZKeyPressed = 80 THEN _     'Down arrow
  1663.          ZFunctionKey = 14
  1664.       IF ZKeyPressed = 81 THEN _     'PgDn
  1665.          ZFunctionKey = 15
  1666.       IF ZKeyPressed = 75 THEN _     'left arrow
  1667.          ZFunctionKey = 16
  1668.       IF ZKeyPressed = 77 THEN _     'Right arrow
  1669.          ZFunctionKey = 17
  1670.       IF ZKeyPressed = 141 THEN _    'CTRL-up arrow
  1671.          ZFunctionKey = 18
  1672.       IF ZKeyPressed = 132 THEN _    'CTRL-PgUp (same as CTRL-UP)
  1673.          ZFunctionKey = 18
  1674.       IF ZKeyPressed = 145 THEN _    'CTRL-down arrow
  1675.          ZFunctionKey = 19
  1676.       IF ZKeyPressed = 118 THEN _    'CTRL-PgDn (same as CTRL-DOWN)
  1677.          ZFunctionKey = 19
  1678.       IF ZKeyPressed = 115 THEN _    'CTRL-left arrow
  1679.          ZFunctionKey = 20
  1680.       IF ZKeyPressed = 116 THEN _    'CTRL-right arrow
  1681.          ZFunctionKey = 21
  1682.       IF ZKeyPressed = 79 THEN _     'End (a nice way to kick user off)
  1683.          ZFunctionKey = 22
  1684. 30610 ZKeyPressed$ = ""
  1685.       IF ZFunctionKey < 1 OR ZFunctionKey > 22 THEN _
  1686.          GOTO 33970
  1687.       IF ZFunctionKey < 10 AND (ZFunctionKey <> 8) THEN _
  1688.          GOTO 30620
  1689.       IF ZToggleOnly THEN _
  1690.          ZSubParm = 1 : _
  1691.          GOTO 33970
  1692. 30620 ON ZFunctionKey GOTO  31000, _            '  1 =  F1
  1693.                             32000, _            '  2 =  F2
  1694.                             33000, _            '  3 =  F3
  1695.                             33040, _            '  4 =  F4
  1696.                             33060, _            '  5 =  F5
  1697.                             33070, _            '  6 =  F6
  1698.                             33090, _            '  7 =  F7
  1699.                             33110, _            '  8 =  F8
  1700.                             33130, _            '  9 =  F9
  1701.                             33150, _            ' 10 = F10
  1702.                             31398, _            ' 11 = CTRL END
  1703.                             33200, _            ' 12 = PGUP
  1704.                             33170, _            ' 13 = UP ARROW
  1705.                             33180, _            ' 14 = DOWN ARROW
  1706.                             33220, _            ' 15 = PGDN
  1707.                             33240, _            ' 16 = LEFT ARROW
  1708.                             33250, _            ' 17 = RIGHT ARROW
  1709.                             33170, _            ' 18 = CTRL-UP ARROW
  1710.                             33180, _            ' 19 = CTRL-DOWN
  1711.                             33245, _            ' 20 = CTRL-LEFT
  1712.                             33255, _            ' 21 = CTRL-RIGHT
  1713.                             31398               ' 22 = END
  1714. '
  1715. '
  1716. ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS)
  1717. '
  1718. '
  1719. 31000 ZSubParm = -10
  1720.       CALL Carrier
  1721.       IF ZSubParm = 0 THEN _
  1722.          GOTO 33970
  1723.       ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "F1.DEF"
  1724.       CLOSE 2
  1725.       CALL OpenOutW (ZFileName$)
  1726.       PRINT #2,MID$(ZFileName$,3,7)
  1727.       IF ZExitToDoors THEN _
  1728.          ZSubParm = -4 : _
  1729.          GOTO 33970
  1730.       CALL OpenCom(ZModemInitBaud$,",N,8,1")
  1731.       CALL TakeOffHook
  1732.       ZSubParm = -5
  1733.       GOTO 33970
  1734. '
  1735. '
  1736. ' *  END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT
  1737. '
  1738. '
  1739. 31398 IF NOT ZLocalUser THEN _
  1740.          CALL Carrier : _
  1741.          IF ZSubParm = -1 THEN _
  1742.             GOTO 33970
  1743.       IF INSTR("MUF",ZActiveMenu$) > 0 THEN _
  1744.          GOTO 31399
  1745.       ZCursorLine = CSRLIN
  1746.       ZCursorRow = POS(0)
  1747.       LOCATE 25,1
  1748.       WasD$ = SPACE$(79)
  1749.       GOSUB 33210
  1750.       LOCATE 25,1
  1751.       WasD$ ="Cannot FORCE OFF until user reaches MAIN menu"
  1752.       GOSUB 33210
  1753.       CALL DelayTime (1)
  1754.       LOCATE ZCursorLine,ZCursorRow
  1755.       ZSubParm = 1
  1756.       CALL Line25
  1757.       GOTO 33970
  1758. 31399 IF ZFunctionKey = 22 THEN _
  1759.          CALL SkipLine (2) : _
  1760.          CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", SYSOP needs the system.") : _
  1761.          CALL DelayTime (8 + ZBPS) : _
  1762.          ZSubParm = -6 : _
  1763.          GOTO 33970
  1764.       CALL QuickTPut1 (ZFirstName$ + ", goodbye and don't call back")
  1765.       CALL DelayTime (8 + ZBPS) : _
  1766.       IF ZUserFileIndex < 1 THEN _
  1767.          ZSubParm = -6 : _
  1768.          GOTO 33970
  1769.       ZUserSecLevel = ZMinLogonSec - 1
  1770.       CALL DenyAccess
  1771.       ZSubParm = -7
  1772.       GOTO 33970
  1773. '
  1774. '
  1775. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
  1776. '
  1777. '
  1778.  
  1779. 32000 IF NOT ZLocalUser THEN _
  1780.          CALL SkipLine (1) : _
  1781.          CALL QuickTPut1 ("Sysop exiting to DOS. Please wait...") : _
  1782.          ZFunctionKey = 0 : _
  1783.          CALL DelayTime (3)
  1784.       CALL ShellExit (ZDiskForDos$ + "COMMAND")
  1785.       'SHELL ZDiskForDos$ + _
  1786.       '      "COMMAND"
  1787.       CLS
  1788.       IF NOT ZLocalUser THEN _
  1789.          CALL Carrier : _
  1790.          IF ZSubParm = -1 THEN _
  1791.             GOTO 33970
  1792.       ZSubParm = 2
  1793.       CALL Line25
  1794.       CALL QuickTPut1 ("Sysop back from DOS.  Returning control to you.")
  1795.       ZCommPortStack$ = ZCarriageReturn$
  1796.       GOTO 33970
  1797. '
  1798. '
  1799. ' * F3 - COMMAND FROM LOCAL KEYBOARD (Printer Toggle)
  1800. '
  1801. '
  1802. 33000 ZPrinter = NOT ZPrinter
  1803.       ChangeValue = ZPrinter
  1804.       FieldPosition = 38
  1805.       GOTO 33950
  1806. '
  1807. '
  1808. ' * F4 - COMMAND FROM LOCAL KEYBOARD (Sysop ANNOY)
  1809. '
  1810. '
  1811. 33040 ZSysopAnnoy = NOT ZSysopAnnoy
  1812.       ChangeValue = ZSysopAnnoy
  1813.       FieldPosition = 34
  1814.       GOTO 33950
  1815. '
  1816. '
  1817. ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE)
  1818. '
  1819. '
  1820. 33060 ZFunctionKey = 0
  1821.       ZSubParm = -3
  1822.       GOTO 33970
  1823. '
  1824. '
  1825. ' * F6 - COMMAND FROM LOCAL KEYBOARD (Sysop AVAILABLE Toggle)
  1826. ' *  6 - COMMAND FROM Sysop MENU (Sysop AVAILABLE Toggle)
  1827. '
  1828. '
  1829. 33070 ZSysopAvail = NOT ZSysopAvail
  1830.       ChangeValue = ZSysopAvail
  1831.       FieldPosition = 32
  1832.       GOTO 33950
  1833. '
  1834. '
  1835. ' * F7 - COMMAND FROM LOCAL KEYBOARD (Sysop GETS SYSTEM NEXT)
  1836. '
  1837. '
  1838. 33090 IF ERR=61 AND NOT ZDiskFullGoOffline THEN _
  1839.          GOTO 33970
  1840.       ZSysopNext = NOT ZSysopNext
  1841.       ChangeValue = ZSysopNext
  1842.       FieldPosition = 36
  1843.       GOTO 33950
  1844. '
  1845. '
  1846. ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY Sysop SECURITY)
  1847. '
  1848. '
  1849. 33110 ZSysop = NOT ZSysop
  1850.       ZCursorLine = CSRLIN
  1851.       ZCursorRow = POS(0)
  1852.       LOCATE 25,1
  1853.       WasD$ = SPACE$(79)
  1854.       NumReturns = 0
  1855.       CALL LPrnt (WasD$,NumReturns)
  1856.       LOCATE 25,1
  1857.       ZUserSecLevel = (1 + ZSysop) * _
  1858.                             ZUserSecSave  - _
  1859.                             ZSysop * _
  1860.                             ZSysopSecLevel
  1861.       WasD$ = "Sysop Privileges " + FNOffOn$(ZSysop)
  1862.       CALL LPrnt (WasD$,NumReturns)
  1863.       CALL DelayTime (3)
  1864.       LOCATE ZCursorLine,ZCursorRow
  1865.       ZSubParm = 1
  1866.       CALL Line25
  1867.       CALL SetPrompt
  1868.       GOTO 33970
  1869. '
  1870. '
  1871. ' * F9 - COMMAND FROM LOCAL KEYBOARD (Snoop Toggle)
  1872. '
  1873. '
  1874. 33130 IF NOT ZSnoop THEN _
  1875.          ZSnoop = ZTrue : _
  1876.          LOCATE 24,1,0 : _
  1877.          WasD$ = "SNOOP ON" : _
  1878.          NumReturns = 0 : _
  1879.          CALL LPrnt (WasD$,NumReturns) : _
  1880.          ZSubParm = 2 : _
  1881.          CALL Line25 _
  1882.       ELSE LOCATE ,,0 : _
  1883.            ZSnoop = ZFalse : _
  1884.            CLS
  1885. 33140 ChangeValue = ZSnoop
  1886.       FieldPosition = 58
  1887.       GOTO 33950
  1888. '
  1889. '
  1890. ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER)
  1891. '
  1892. '
  1893. 33150 GOTO 33160
  1894. 33155 ZSubParm = 1
  1895.       CALL Line25
  1896.       GOTO 33970
  1897. 33160 CALL UpdtCalr ("Sysop began chat",1)
  1898.       ZPageStatus$ = ""
  1899.       CALL SkipLine (1)
  1900.       CALL QuickTPut1 ("Hi " + _
  1901.            ZFirstName$ + _
  1902.            ", this is " + _
  1903.            ZSysopFirstName$ + _
  1904.            " " + _
  1905.            ZSysopLastName$ + _
  1906.            "  Sorry to break in to CHAT but..")
  1907.       CALL TimeBack (1)
  1908.       CALL SysopChat
  1909.       CALL TimeBack (2)
  1910.       ZCommPortStack$ = CHR$(13)
  1911.       GOTO 33155
  1912. '
  1913. '
  1914. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1915. '
  1916. '
  1917. 33170 ZUserSecLevel = ZUserSecLevel + _
  1918.                             1 - 4 * (ZFunctionKey = 18)
  1919.       GOTO 33190
  1920. '
  1921. '
  1922. ' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
  1923. '
  1924. '
  1925. 33180 ZUserSecLevel = ZUserSecLevel - _
  1926.                             1 + 4 * (ZFunctionKey = 19)
  1927. 33190 ZAdjustedSecurity = ZTrue
  1928.       ZUserSecSave = ZUserSecLevel
  1929.       IF (NOT ZConfMode) AND (NOT SubBoard) THEN _
  1930.          ZOrigSec = ZUserSecLevel : _
  1931.       ZSubParm = 2
  1932.       CALL Line25
  1933.       CALL SetPrompt
  1934.       GOTO 33970
  1935. '
  1936. '
  1937. ' * PGUP DISPLAY USER PROFILE
  1938. '
  1939. '
  1940. 33200 IF NOT ZLocalUser THEN _
  1941.          CALL Carrier : _
  1942.          IF ZSubParm = -1 THEN _
  1943.             GOTO 33970
  1944.       IF ZVoiceType <> 0 THEN _
  1945.          ZTalkAll = ZTrue
  1946.       CALL PageUp
  1947.       WasD$ = MID$("NoviceExPERT",1 -6 * ZExpertUser,6)
  1948.       GOSUB 33210
  1949.       WasD$ = "GRAPHICS: " + _
  1950.            MID$("None AsciiColor",ZWasGR * 5 + 1,5)
  1951.       GOSUB 33210
  1952.       WasD$ = "Protocol : " + _
  1953.            ZUserXferDefault$
  1954.       GOSUB 33210
  1955.       WasD$ = "UPPER CASE " + _
  1956.            MID$("and lowerONLY", 1 - 9 * ZUpperCase,9)
  1957.       GOSUB 33210
  1958.       WasD$ = "Line Feeds " + FNOffOn$(ZLineFeeds)
  1959.       GOSUB 33210
  1960.       WasD$ = "Nulls " + FNOffOn$(ZNulls)
  1961.       GOSUB 33210
  1962.       WasD$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
  1963.       GOSUB 33210
  1964.       WasD$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _
  1965.            " old BULLETINS on logon."
  1966.       GOSUB 33210
  1967.       WasD$ = MID$("CHECKSKIP ",1 -5 * ZSkipFilesLogon,5) + _
  1968.            " new files on logon."
  1969.       GOSUB 33210
  1970.       WasD$ = "Autodownload " + FNOffOn$(ZAutoDownDesired)
  1971.       GOSUB 33210
  1972.       ZTalkAll = ZFalse
  1973.       GOTO 33970
  1974. 33210 NumReturns = 1
  1975.       CALL LPrnt(WasD$,NumReturns)
  1976.       RETURN
  1977. '
  1978. '
  1979. ' * PGDN CLEAR DISPLAY OF USER'S PROFILE
  1980. '
  1981. '
  1982. 33220 IF NOT ZLocalUser THEN _
  1983.          CALL Carrier : _
  1984.          IF ZSubParm = -1 THEN _
  1985.             GOTO 33970
  1986.       CLS
  1987.       GOTO 33155
  1988. '
  1989. '
  1990. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  1991. '
  1992. '
  1993. 33240 IF ZSecsPerSession! > 120 THEN _
  1994.          ZSecsPerSession! = ZSecsPerSession! - 60
  1995.       GOTO 33970
  1996. '
  1997. '
  1998. ' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  1999. '
  2000. '
  2001. 33245 IF ZSecsPerSession! > 360 THEN _
  2002.          ZSecsPerSession! = ZSecsPerSession! - 300
  2003.       GOTO 33970
  2004. '
  2005. '
  2006. ' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE
  2007. '
  2008. '
  2009. 33250 IF ZSecsPerSession! < 86280 THEN _
  2010.          ZSecsPerSession! = ZSecsPerSession! + 60
  2011.       ZTimeLockSet = 0
  2012.       GOTO 33970
  2013. '
  2014. '
  2015. ' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
  2016. '
  2017. '
  2018. 33255 IF ZSecsPerSession! < 86040 THEN _
  2019.          ZSecsPerSession! = ZSecsPerSession! + 300
  2020.       ZTimeLockSet = 0
  2021.       GOTO 33970
  2022. '
  2023. '
  2024. ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY
  2025. '
  2026. '
  2027. 33950 IF ZSnoop THEN _
  2028.          ZSubParm = 1 : _
  2029.          CALL Line25
  2030. 33960 IF ZConfMode = ZTrue THEN _
  2031.          IF ZLocalUser THEN _
  2032.             GOTO 33970 _
  2033.          ELSE WasD$ = "Cannot change status during Conference!" : _
  2034.               GOSUB 33210 : _
  2035.               GOTO 33970
  2036.       ZSubParm = 3
  2037.       CALL FileLock
  2038.       IF ZSubParm = -1 THEN _
  2039.          GOTO 33970
  2040.       CALL OpenMsg
  2041.       FIELD 1,128 AS ZMsgRec$
  2042.       GET 1,ZNodeRecIndex
  2043.       MID$(ZMsgRec$,FieldPosition,2) = STR$(ChangeValue)
  2044.       CALL SaveProf (2)
  2045.       FIELD 1, 128 AS ZMsgRec$
  2046. 33970 END SUB
  2047. 33990 ' $SUBTITLE: 'PageUp - Display user profile to Sysop'
  2048. ' $PAGE
  2049. '
  2050. '  NAME    -- PageUp
  2051. '
  2052. '  INPUTS  --     PARAMETER                    MEANING
  2053. '                 ZActiveUserName$       CURRENT USER NAME
  2054. '                 ZDnlds                 # OF FILES DOWNLOADED
  2055. '                 ZExpirationDate$       REGISTRATION EXPIRATION
  2056. '                 ZLastDateTimeOnSave$   Last DATE & TIME ON SYSTEM
  2057. '                 ZLastMsgRead           Last MESSAGE READ BY USER
  2058. '                 ZPswdSave$             USERS PASSWORD
  2059. '                 ZTimesLoggedOn         TIMES USER HAS LOGGED ON
  2060. '                 ZUplds                 # OF FILES UPLOADED
  2061. '                 ZUserSecSave           USERS SECURITY LEVEL
  2062. '
  2063. '  OUTPUTS -- ZMsgRec$
  2064. '
  2065.       SUB PageUp STATIC
  2066.       CALL LPrnt (" ",1)
  2067.       CALL LPrnt ("USER NAME : " + ZActiveUserName$,1)
  2068.       CALL LPrnt ("SECURITY  :" + STR$(ZUserSecSave),1)
  2069.       CALL LPrnt ("PASSWORD  :" + ZPswdSave$,1)
  2070.       CALL LPrnt ("READ MSG. :" + STR$(ZLastMsgRead),1)
  2071.       CALL LPrnt ("TIMES ON  :" + STR$(ZTimesLoggedOn),1)
  2072.       CALL LPrnt ("LAST ON   :" + ZLastDateTimeOnSave$,1)
  2073.       CALL LPrnt ("DOWNLOADS :" + STR$(ZDnlds),1)
  2074.       CALL LPrnt ("UPLOADS   :" + STR$(ZUplds),1)
  2075.       IF ZEnforceRatios THEN _
  2076.          CALL LPrnt ("DL-BYTES  :" + STR$(ZDLBytes!),1) : _
  2077.          CALL LPrnt ("UL-BYTES  :" + STR$(ZULBytes!),1)
  2078.       IF ZRestrictByDate THEN _
  2079.          CALL LPrnt ("EXPIRATION: " + ZExpirationDate$,1)
  2080.       CALL LPrnt ("User's Profile",1)
  2081.       END SUB
  2082. 35000 ' $SUBTITLE: 'FlushKeys - Completely flush all user input'
  2083. ' $PAGE
  2084. '
  2085. '  NAME    -- FlushKeys
  2086. '
  2087.       SUB FlushKeys STATIC
  2088.       CALL FlushCom (ZWasY$)                                         ' KG071901
  2089.       ZLastIndex = 0
  2090.       REDIM ZUserIn$(ZMsgDim)
  2091.       END SUB
  2092. 41008 ' $SUBTITLE: 'CheckTimeRemain - Kicks off if no time remaining'
  2093. ' $PAGE
  2094. '
  2095. '  NAME    -- CheckTimeRemain
  2096. '
  2097. '  INPUTS  -- PARAMETER                 MEANING
  2098. '
  2099. '  OUTPUTS -- PARAMETER                 MEANING
  2100. '             MinsRemaining         TIME IN MINUTES LEFT IN SESSION
  2101. '             ZSecsUsedSession!     TIME USED IN SECONDS
  2102. '             ZSubParm              -1 IF No TIME LEFT
  2103. '
  2104.       SUB CheckTimeRemain (MinsRemaining) STATIC
  2105.       CALL TimeRemain (MinsRemaining)
  2106.       IF ZBypassTimeCheck THEN _
  2107.          EXIT SUB
  2108.       IF MinsRemaining <= 0 THEN _
  2109.          ZSubParm = -1
  2110.       END SUB
  2111. 41010 ' $SUBTITLE: 'TimeRemain - calculates time remaining in a session'
  2112. ' $PAGE
  2113. '
  2114. '  NAME    -- TimeRemain
  2115. '
  2116. '  INPUTS  -- PARAMETER                 MEANING
  2117. '             ZUserLogonTime!          WHEN DID THE CALLER GET HERE
  2118. '             ZSecsPerSession!         HOW LONG MAY THE CALLER STAY ON
  2119. '             ZTimeToDropToDos!        WHEN ARE WE DOING OUR DAILY EVENT
  2120. '             ZBypassTimeCheck         DO WE CARE HOW LONG THEY CAN STAY
  2121. '
  2122. '  OUTPUTS -- PARAMETER                 MEANING
  2123. '             MinsRemaining            TIME IN MINUTES LEFT IN SESSION
  2124. '             ZSecsUsedSession!        TIME USED IN SECONDS
  2125. '
  2126.       SUB TimeRemain (MinsRemaining) STATIC
  2127.       TOA! = FRE("A")
  2128.       IF ZBypassTimeCheck THEN _
  2129.          MinsRemaining = ZSecsPerSession! / 60 : _
  2130.          EXIT SUB
  2131.       CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  2132.       IF ZTimeToDropToDos! = 0 OR _
  2133.          ZOldDate$ = DATE$ THEN _
  2134.          GOTO 41020
  2135.       CALL CheckTime (ZTimeToDropToDos!, HowMuchTimeLeft!, 1)
  2136.       IF HowMuchTimeLeft! < -60 THEN _                               ' DA091601
  2137.          HowMuchTimeLeft! = (HowMuchTimeLeft! * -1) + 43200          ' ML080801
  2138.       IF (ZSecsPerSession! - ZSecsUsedSession!) > HowMuchTimeLeft! THEN _ ' DA080101
  2139.          ZSecsPerSession! = HowMuchTimeLeft! + ZSecsUsedSession! : _ ' DA080101
  2140.          IF NOT ToldShort THEN _
  2141.             ToldShort = ZTrue : _
  2142.             ZOutTxt$ = "Shortened session time to" + _               ' DA080101
  2143.                 STR$(INT((ZSecsPerSession! - ZSecsUsedSession!) / 60)) + _ ' DA080101
  2144.                 " min for scheduled event" : _                       ' DA080101
  2145.             CALL RingCaller
  2146. 41020 MinsRemaining = INT((ZSecsPerSession! - ZSecsUsedSession!) / 60) ' ML080802
  2147.       END SUB
  2148. 41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining'
  2149. ' $PAGE
  2150. '
  2151. '  NAME    -- DispTimeRemain
  2152. '
  2153. '  INPUTS  --     PARAMETER                    MEANING
  2154. '              MinsRemaining
  2155. '
  2156. '  OUTPUTS --     PARAMETER                    MEANING
  2157. '                MinsRemaining               TIME IN MINUTES LEFT IN SESSION
  2158. '
  2159.       SUB DispTimeRemain (MinsRemaining) STATIC
  2160.       CALL TimeRemain (MinsRemaining)
  2161.       CALL QuickTPut1 (ZEmphasizeOff$ + STR$(MinsRemaining) + " min left") ' MB052101
  2162.       END SUB
  2163. 41498 ' $SUBTITLE: 'AMorPM - give time of day in AM/PM format'
  2164. ' $PAGE
  2165. '
  2166. '  NAME    -- AMorPM
  2167. '
  2168. '  INPUTS  --     PARAMETER                    MEANING
  2169. '
  2170. '  OUTPUTS -- ZCurDate$                 CURRENT DATE (MM-DD-YY)
  2171. '             ZTime$                    CURRENT TIME (I.E. 1:13 PM)
  2172. '
  2173. '  PURPOSE -- To set the time and date and
  2174. '             describe the time as "AM" or "PM."
  2175. '
  2176.       SUB AMorPM STATIC
  2177. '
  2178. '
  2179. ' *  CALCULATE CURRENT TIME FOR AM OR PM
  2180. '
  2181. '
  2182. 41500 ZCurDate$ = DATE$
  2183.       ZCurDate$ = LEFT$(ZCurDate$ ,6) + _
  2184.                       RIGHT$(ZCurDate$ ,2)
  2185. 41510 ZTime$ = TIME$
  2186.       IF VAL(MID$(ZTime$,1,2)) = 12 THEN _
  2187.          MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))),2) : _
  2188.          ZTime$ = LEFT$(ZTime$,5) + _
  2189.                 " PM" : _
  2190.          EXIT SUB
  2191.       IF VAL(MID$(ZTime$,1,2)) > 11 THEN _
  2192.          MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))-12),2) : _
  2193.          ZTime$ = LEFT$(ZTime$,5) + _
  2194.                 " PM" : _
  2195.          EXIT SUB
  2196.       ZTime$ = LEFT$(ZTime$,5) + _
  2197.              " AM"
  2198.       END SUB
  2199. 42000 ' $SUBTITLE: 'Carrier - sub to monitor carrier on comm. port'
  2200. ' $PAGE
  2201. '
  2202. '  NAME    -- Carrier
  2203. '
  2204. '  INPUTS  --     PARAMETER                    MEANING
  2205. '              ZAutoLogoffReq                  -1 if in autologoff request
  2206. '
  2207. '  OUTPUTS --  ZSubParm = 0                    CONTINUE
  2208. '              ZSubParm = -1                   TERMINATE (No Carrier)
  2209. '
  2210. '  PURPOSE --  To test whether should continue in RBBS.  Reasons
  2211. '              NOT to continue are:  autologoff, out of time, or
  2212. '              carrier dropped.
  2213. '
  2214.       SUB Carrier STATIC
  2215.       IF ZAutoLogoffReq THEN _
  2216.          IF NOT ZSuspendAutologoff THEN _
  2217.             ZSubParm = -1 : _
  2218.             EXIT SUB
  2219.       CALL CheckCarrier
  2220.       END SUB
  2221. 42005 ' $SUBTITLE: 'CheckCarrier - monitors carrier on comm. port'
  2222. ' $PAGE
  2223. '
  2224. '  NAME    -- CheckCarrier
  2225. '
  2226. '  INPUTS  --     PARAMETER                    MEANING
  2227. '              ZLocalUser = 0               REMOTE USER
  2228. '              ZLocalUser = -1              LOCAL KEYBOARD USER
  2229. '              ZModemStatusReg              ADDRESS OF THE COMMUNI-
  2230. '                                           CATIONS PORT'S REGISTER
  2231. '              ZSubParm = -9                DON'T WRITE TO CALLERS
  2232. '              ZSubParm = -10               SAME AS -9, BUT DON'T
  2233. '                                           DELAY
  2234. '
  2235. '  OUTPUTS --  ZSubParm = 0                 Carrier STILL PRESENT
  2236. '              ZSubParm = -1                Carrier NOT PRESENT
  2237. '
  2238. '  PURPOSE --  To test if carrier is present (i.e. the user
  2239. '              is still on line).  Ignores whether in autologoff.
  2240. '
  2241.       SUB CheckCarrier STATIC
  2242.       IF ZSubParm = -1 THEN _
  2243.          EXIT SUB
  2244.       Speedy = ZSubParm
  2245.       ZSubParm = 0
  2246. '
  2247. '
  2248. ' * TEST FOR Carrier PRESENT (DROP CALLER IF Carrier NOT PRESENT)
  2249. '
  2250. '
  2251.       IF ZLocalUser THEN _
  2252.          EXIT SUB
  2253.       IF ZFossil THEN _
  2254.          CALL FosStatus(ZComPort,Status) : _
  2255.          Status = Status AND &H0080 : _
  2256.          IF Status = &H0080 THEN _
  2257.             EXIT SUB _
  2258.          ELSE GOTO 42015
  2259. 42010 IF INP(ZModemStatusReg) > 127 THEN _
  2260.          EXIT SUB
  2261. '
  2262. '
  2263. ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR Carrier
  2264. ' * DETECT.  SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE Carrier,
  2265. ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN.
  2266. '
  2267. '
  2268. 42015 IF Speedy = -10 THEN _
  2269.          GOTO 42020
  2270.       CALL DelayTime (ZModemInitWaitTime)
  2271.       IF ZFossil THEN _
  2272.          CALL FosStatus(ZComPort,Status) : _
  2273.          Status = Status AND &H0080 : _
  2274.          IF Status = &H0080 THEN _
  2275.             EXIT SUB _
  2276.          ELSE GOTO 42020
  2277.       IF INP(ZModemStatusReg) > 127 THEN _
  2278.          EXIT SUB
  2279. 42020 ZSubParm = -1
  2280.       IF Speedy < -8 THEN _
  2281.          EXIT SUB
  2282.       IF AlreadyWritten = -9 THEN _
  2283.          EXIT SUB
  2284.       CALL TakeOffHook
  2285.       ZModemOffHook = -1
  2286.       AlreadyWritten = -9
  2287.       CALL UpdtCalr ("Carrier dropped",1)
  2288.       END SUB
  2289. 43004 ' $SUBTITLE: 'AskGraphics -- sub to ask users graphic preference'
  2290. ' $PAGE
  2291. '
  2292. '  NAME    -- AskGraphics
  2293. '
  2294. '  INPUTS  --    PARAMETER                    MEANING
  2295. '                ZUserGraphicDefault$        USER Graphic DEFAULT
  2296. '
  2297. '  OUTPUTS --
  2298. '
  2299. '  PURPOSE --  To determine users graphics default
  2300. '
  2301.       SUB AskGraphics STATIC
  2302.       IF ZExpertUser THEN _
  2303.          GOTO 43007
  2304. 43006 ZFileName$ = ZHelp$(9)
  2305.       CALL BufFile (ZFileName$,WasX)
  2306.       IF ZSubParm = -1 THEN _
  2307.          EXIT SUB
  2308. 43007 CALL QuickTPut1 ("GRAPHICS for text files and menus")
  2309.       ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$
  2310.       ZSubParm = 1
  2311.       ZTurboKey = -ZTurboKeyUser
  2312.       CALL TGet
  2313.       IF ZSubParm = -1 THEN _
  2314.          EXIT SUB
  2315.       IF ZWasQ = 0 THEN _
  2316.          CALL QuickTPut1 ("Unchanged") : _
  2317.          EXIT SUB
  2318.       CALL AllCaps (ZUserIn$(1))
  2319.       ZWasGR = INSTR("NAC",ZUserIn$(1))
  2320.       IF ZWasGR = 2 AND NOT ZEightBit THEN _
  2321.          CALL QuickTPut1 ("Ascii unavailable.  Requires 8 bit") : _
  2322.          GOTO 43007
  2323.       IF ZWasGR = 0 THEN _
  2324.          GOTO 43006
  2325.       ZWasGR = ZWasGR - 1
  2326.       CALL SetGraphic (ZWasGR,ZUserGraphicDefault$)
  2327.       END SUB
  2328. '
  2329. 43031 ' $SUBTITLE: 'GraphicX - sub to find graphic version of a file'
  2330. ' $PAGE
  2331. '
  2332. '  NAME    -- GraphicX
  2333. '
  2334. '  INPUTS  --     PARAMETER                    MEANING
  2335. '                 Default$              USERS Graphic DEFAULT
  2336. '                 ZWasGR                WHETHER GRAPHICS ARE AVAILABLE
  2337. '                 FilName$              FILE TO CHECK
  2338. '                 FileNum               # of file to use
  2339. '
  2340. '  OUTPUTS --     FilName$              SUBSTITUTES NAME OF GRAPHICS
  2341. '                                       FILE (IF IT EXISTS).
  2342. '
  2343. '  PURPOSE -- Checks whether there is a graphics version of
  2344. '             a file, based on users graphics perference.
  2345. '             Sets file name to graphics file if it exists,
  2346. '             Otherwise leaves file name intact.  Returns file
  2347. '             name to use.
  2348. '
  2349.       SUB GraphicX (Default$,FilName$,FileNum) STATIC
  2350.       ZOK = ZFalse
  2351.       IF ZWasGR THEN _
  2352.          CALL BreakFileName (FilName$,DR$,WasX$,Extension$,ZTrue) : _
  2353.          IF LEN(WasX$) < 8 THEN _
  2354.             ZWasDF$ = DR$ + _
  2355.                   WasX$ + _
  2356.                   Default$ + _
  2357.                   Extension$ : _
  2358.              CALL FINDITX (ZWasDF$,FileNum) : _
  2359.              IF ZOK THEN _
  2360.                 FilName$ = ZWasDF$ : _
  2361.                 IF Default$ = "C" THEN _
  2362.                    ZLinesPrinted = 0
  2363.       IF NOT ZOK THEN _
  2364.          CALL FINDITX (FilName$,FileNum)
  2365.       END SUB
  2366. ' Sets Graphic version but uses file # 2 always
  2367.       SUB Graphic (Default$,FilName$) STATIC
  2368.       CALL GraphicX (Default$,FilName$,2)
  2369.       END SUB
  2370. 43068 ' $SUBTITLE: 'SaveProf - subroutine to read a user profile'
  2371. ' $PAGE
  2372. '
  2373. '  NAME    -- SaveProf
  2374. '
  2375. '  INPUTS  --     PARAMETER                    MEANING
  2376. '              ZBPS
  2377. '              ZEightBit
  2378. '              ZExitToDoors
  2379. '              ZWasGR
  2380. '              ZMsgRec$
  2381. '              ZNodeRecIndex
  2382. '              ZSysop
  2383. '              ZUpperCase
  2384. '              ZTimeLoggedOn$
  2385. '              ZPrivateDoor
  2386. '              ZReliableMode
  2387. '
  2388. '  OUTPUTS -- NONE
  2389. '
  2390. '  PURPOSE -- Saves a user's options and communications parameters
  2391. '             in the node record when a user exits to a "door" so
  2392. '             that he is in the same status as when he exited.
  2393. '
  2394.       SUB SaveProf (IParm) STATIC
  2395.       ON IParm GOTO 43070,43080
  2396. 43070 ZActiveMessageFile$ = ZOrigMsgFile$
  2397.       ZSubParm = 3
  2398.       CALL FileLock
  2399.       CALL OpenMsg
  2400.       FIELD 1, 128 AS ZMsgRec$
  2401.       GET 1,ZNodeRecIndex
  2402.       IF ZGlobalSysop THEN _
  2403.          MID$(ZMsgRec$,1,30) = "SYSOP" + SPACE$(25)
  2404.       MID$(ZMsgRec$,40,2) = STR$(ZExitToDoors)
  2405.       MID$(ZMsgRec$,42,2) = STR$(ZEightBit)
  2406.       MID$(ZMsgRec$,44,2) = STR$(ZBPS)
  2407.       MID$(ZMsgRec$,46,2) = STR$(ZUpperCase)
  2408.       MID$(ZMsgRec$,48,5) = MKS$(ZNumDnldBytes!) + MID$(STR$(-ZBatchTransfer),2) ' KG022101
  2409.       MID$(ZMsgRec$,53,2) = STR$(ZWasGR)
  2410.       MID$(ZMsgRec$,55,2) = STR$(ZSysop)
  2411.       MID$(ZMsgRec$,65,3) = CHR$(VAL(LEFT$(ZTimeLoggedOn$,2))) + _
  2412.                                    CHR$(VAL(MID$(ZTimeLoggedOn$,4,2))) + _
  2413.                                    CHR$(VAL(MID$(ZTimeLoggedOn$,7,2)))
  2414.       MID$(ZMsgRec$,72,2) = STR$(ZPrivateDoor)
  2415.       MID$(ZMsgRec$,74,1) = MID$(STR$(ZTransferFunction),2,1)
  2416.       MID$(ZMsgRec$,75,1) = ZWasFT$
  2417.       MID$(ZMsgRec$,113,2) = MKI$(CINT(ZTimeCredits!)/60)
  2418.       MID$(ZMsgRec$,79,8) = LEFT$(ZDooredTo$+"        ",8)
  2419.       MID$(ZMsgRec$,91,2) = STR$(ZReliableMode)
  2420.       CALL BreakFileName (ZCurPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZFalse)
  2421.       MID$(ZMsgRec$,93,8) = ZUserIn$ + SPACE$(8 - LEN(ZUserIn$))
  2422.       IF ZLocalUser THEN _
  2423.          ZWasZ$ = ZCarriageReturn$ + ZCarriageReturn$ _              ' KG030601
  2424.       ELSE ZWasZ$ = " 0"                                             ' KG030601
  2425.       MID$(ZMsgRec$,101,2) = ZWasZ$                                  ' KG030601
  2426.       MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode)                    ' KG030601
  2427.       ZConfName$ = LEFT$(ZConfName$,INSTR(ZConfName$ + " "," ") - 1)
  2428.       MID$(ZMsgRec$,105,8) = ZConfName$ + SPACE$(8 - LEN(ZConfName$))
  2429.       MID$(ZMsgRec$,115,1) = MID$(STR$(ZAutoLogoffReq),2,1)
  2430.       MID$(ZMsgRec$,117,2) = STR$(ZMenuIndex)
  2431.       MID$(ZMsgRec$,119,2) = LEFT$(DATE$,2)
  2432.       MID$(ZMsgRec$,121,2) = MID$(DATE$,4,2)
  2433.       MID$(ZMsgRec$,123,2) = RIGHT$(DATE$,2)
  2434.       MID$(ZMsgRec$,125,2) = LEFT$(TIME$,2)
  2435.       MID$(ZMsgRec$,127,2) = MID$(TIME$,4,2)
  2436. ' ***   Save additional parameters for door restoral
  2437.       CALL OpenOutW (ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  2438.       CALL PrintWorkA (STR$(ZLimitMinsPerSession))
  2439.       CALL PrintWorkA (ZWasNG$)                                      ' KG052701
  2440.       CALL PrintWorkA (ZIndivValue$)                                 ' NC050901
  2441.       CALL PrintWorkA (ZOrigDateTimeOn$)                             ' KG070601
  2442.       CALL PrintWorkA (ZOrigTimeLoggedOn$)                           ' KG070601
  2443.       CLOSE 2
  2444. 43080 PUT 1,ZNodeRecIndex
  2445.       ZSubParm = 2
  2446.       CALL FileLock
  2447.       CALL OpenMsg
  2448.       END SUB
  2449. 44000 ' $SUBTITLE: 'ReadProf - subroutine to restore a user profile'
  2450. ' $PAGE
  2451. '
  2452. '  NAME    -- ReadProf
  2453. '
  2454. '  INPUTS  --     PARAMETER                    MEANING
  2455. '              ZNodeRecIndex               NODE RECORD TO USE
  2456. '              ZSysopPswd1$               Sysop'S PSEUDONYM 1
  2457. '              ZSysopPswd2$               Sysop'S PSEUDONYM 2
  2458. '
  2459. '  OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2460. '             UPON EXITING RBBS-PC TO A "DOOR"
  2461. '
  2462. '  PURPOSE -- Reset a user's options and communications parameters
  2463. '             that were saved in the node record when a user exited
  2464. '             to a "door" so that he is in the same status as when
  2465. '             he exited.
  2466. '
  2467.       SUB ReadProf STATIC
  2468.       FIELD 1, 128 AS ZMsgRec$
  2469.       GET 1,ZNodeRecIndex
  2470.       ZReliableMode = VAL(MID$(ZMsgRec$,91,2))
  2471.       MID$(ZMsgRec$,40,2) = "00"
  2472.       ZEightBit = VAL(MID$(ZMsgRec$,42,2))
  2473.       ZBPS = VAL(MID$(ZMsgRec$,44,2))
  2474.       CALL CommInfo
  2475.       ZBaudTest! = VAL(MID$(ZBaudRates$,(-5 * ZBPS),5))
  2476.       ZUpperCase = VAL(MID$(ZMsgRec$,46,2))
  2477.       ZNumDnldBytes! = CVS(MID$(ZMsgRec$,48,4))                      ' KG022101
  2478.       ZBatchTransfer = (MID$(ZMsgRec$,52,1) = "1")
  2479.       ZWasGR = VAL(MID$(ZMsgRec$,53,2))
  2480.       HourLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,65,1))),2),2)
  2481.       MinLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,66,1))),2),2)
  2482.       SecLoggedOn$  = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,67,1))),2),2)
  2483.       ZTimeLoggedOn$ = HourLoggedOn$ + _
  2484.                         ":" + _
  2485.                         MinLoggedOn$ + _
  2486.                         ":" + _
  2487.                         SecLoggedOn$
  2488.       ZTransferFunction = VAL(MID$(ZMsgRec$,74,1))
  2489.       ZWasFT$ = MID$(ZMsgRec$,75,1)
  2490.       ZTimeCredits! = 60!*CVI(MID$(ZMsgRec$,113,2))                  ' KKG030901
  2491.       ZDooredTo$ = MID$(ZMsgRec$,79,8)
  2492.       CALL Trim (ZDooredTo$)
  2493.       IF ZExitToDoors AND ZDooredTo$ <> "" THEN _
  2494.          CALL OpenWork (2,ZDoorsDef$) : _
  2495.          IF ZErrCode = 0 THEN _
  2496.             CALL ReadParms (ZOutTxt$(),8,1) : _
  2497.             WHILE ZErrCode = 0 AND ZOutTxt$(1) <> ZDooredTo$ : _
  2498.                CALL ReadParms (ZOutTxt$(),8,1) : _
  2499.             WEND : _
  2500.             IF ZOutTxt$(1) = ZDooredTo$ THEN _
  2501.                ZDoorSkipsPswd = (ZOutTxt$(6) <> "Y")                 ' ML082001
  2502.       ZErrCode = 0
  2503.       ZMenuIndex = VAL(MID$(ZMsgRec$,117,2))
  2504.       ZCurPUI$ = MID$(ZMsgRec$,93,8)
  2505.       CALL Remove (ZCurPUI$," ")
  2506.       IF ZCurPUI$ <> "" THEN _
  2507.          CALL BreakFileName (ZMainPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZTrue) : _
  2508.          ZCurPUI$ = ZOutTxt$ + ZCurPUI$ + ZWasZ$
  2509.       ZCustomPUI = (ZCurPUI$ <> "")
  2510.       ZLocalUser = (MID$(ZMsgRec$,101,2) = ZCarriageReturn$ + ZCarriageReturn$) ' KG030601
  2511.       ZLocalUserMode = VAL(MID$(ZMsgRec$,103,2))
  2512.       ZHomeConf$ = MID$(ZMsgRec$,105,8)
  2513.       ZAutoLogoffReq = (VAL(MID$(ZMsgRec$,115,1)) <> 0)
  2514.       CALL Trim (ZHomeConf$)
  2515.       IF ZRequiredRings > 0 AND _
  2516.          INSTR(ZModemInitCmd$,"S0=255") THEN _
  2517.          COLOR 7,0,0 _
  2518.       ELSE COLOR ZFG,ZBG,ZBorder
  2519.       IF ZLocalUserMode THEN _
  2520.          GOTO 44003
  2521.       CALL SetBaud
  2522. 44003 ZUserLogonTime! = VAL(HourLoggedOn$) * 3600! + _               ' KK030901
  2523.                         VAL(MinLoggedOn$) * 60! + _                  ' KK030901
  2524.                         VAL(SecLoggedOn$)
  2525.       HourLoggedOn$ = ""
  2526.       MinLoggedOn$ = ""
  2527.       SecLoggedOn$ = ""
  2528.       IF ZMinsPerSession < 1 THEN _
  2529.          ZMinsPerSession = 3
  2530.       IF NOT ZEightBit THEN _
  2531.          OUT ZLineCntlReg,&H1A
  2532.       IF LEFT$(ZMsgRec$,7) = "SYSOP  " THEN _
  2533.          ZFirstName$ = ZSysopPswd1$ : _
  2534.          ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  2535.       ELSE ZFirstNameEnd = INSTR(ZMsgRec$," ") : _
  2536.            ZLastNameEnd = INSTR(ZFirstNameEnd + 1,ZMsgRec$ + " ","  ") : _
  2537.            ZFirstName$ = LEFT$(ZMsgRec$,ZFirstNameEnd-1) : _
  2538.            ZLastName$ = MID$(ZMsgRec$,ZFirstNameEnd + 1,ZLastNameEnd - (ZFirstNameEnd + 1)) : _
  2539.            ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31)
  2540.       ZWasZ$ = ZFirstName$
  2541.       CALL OpenWork (2,ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
  2542.       CALL ReadDir (2,1)
  2543.       ZLimitMinsPerSession = VAL (ZOutTxt$)
  2544.       CALL ReadDir (2,1)                                             ' KG052701
  2545.       ZWasNG$ = ZOutTxt$                                             ' KG052701
  2546.       CALL ReadDir (2,1)                                             ' RC050901
  2547.       ZIndivValue$ = ZOutTxt$                                        ' RC050901
  2548.       CALL ReadDir (2,1)                                             ' KG070601
  2549.       ZOrigDateTimeOn$ = ZOutTxt$                                    ' KG070601
  2550.       CALL ReadDir (2,1)                                             ' KG070601
  2551.       ZOrigTimeLoggedOn$ = ZOutTxt$                                  ' KG070601
  2552.       CLOSE 2
  2553.       END SUB
  2554. 44020 ' $SUBTITLE: 'CommInfo - sub for variable of users baud/parity'
  2555. ' $PAGE
  2556. '
  2557. '  NAME    -- CommInfo
  2558. '
  2559. '  INPUTS  --     PARAMETER                    MEANING
  2560. '                 ZBPS                BAUD RATE INDICATOR
  2561. '                 ZEightBit           INDICATE FOR N/8/1
  2562. '
  2563. '  OUTPUTS -- ZBaudParity$
  2564. '
  2565. '  PURPOSE -- Create a string that shows a users baud rate and parity
  2566. '
  2567.       SUB CommInfo STATIC
  2568. '
  2569. '
  2570. ' *  DETERMINE BAUD AND PARITY
  2571. '
  2572. '
  2573.   IF ZReliableMode THEN _
  2574.      ReliableMode$ = "-R," _
  2575.   ELSE ReliableMode$ = ","
  2576.   ZBaudParity$ = MID$(ZBaudRates$,(-5 * ZBPS),5) + _
  2577.                  " BAUD" + _
  2578.                  ReliableMode$ + _
  2579.                  MID$("N,8,1E,7,1",6 + 5 * ZEightBit,5)
  2580.   ZBaudTest! = VAL(ZBaudParity$)
  2581.   END SUB
  2582. 50495 ' $SUBTITLE: 'DelayTime - sub to wait number of seconds specified'
  2583. ' $PAGE
  2584. '
  2585. '  NAME    -- DelayTime
  2586. '
  2587. '  INPUTS  --     PARAMETER                    MEANING
  2588. '                 DelaySecs           NUMBER OF SECONDS TO DELAY
  2589. '                                      (0 TO 3,600)
  2590. '
  2591. '  OUTPUTS -- NONE
  2592. '
  2593. '  PURPOSE -- To wait the number of seconds indicated before
  2594. '             returning control to the calling routine.
  2595. '
  2596.       SUB DelayTime (DelaySecs) STATIC
  2597.       IF DelaySecs < 1 THEN _
  2598.          EXIT SUB
  2599.       ZDelay! = TIMER + DelaySecs
  2600. 50500 CALL CheckTime(ZDelay!, TempElapsed!, 1)
  2601.       IF TempElapsed! > 0 THEN _
  2602.          GOTO 50500
  2603.       END SUB
  2604. 52070 ' $SUBTITLE: 'ModemPut - sub to write modem commands to modem'
  2605. ' $PAGE
  2606. '
  2607. '  SUBROUTINE NAME    -- ModemPut
  2608. '
  2609. '  INPUT PARAMETERS   --     PARAMETER               MEANING
  2610. '                            Strng$                MODEM COMMAND
  2611. '                            ZCmdsBetweenRings     INDICATOR TO WAIT FOR
  2612. '                                                  MODEM TO STOP RINGING
  2613. '                                                  BEFORE ISSUING COMMANDS
  2614. '                            ZDumbModem            INDICATOR THAT MODEM WOULD
  2615. '                                                  NOT UNDERSTAND COMMANDS
  2616. '
  2617. '  OUTPUT PARAMETERS  -- NONE
  2618. '
  2619. '  SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
  2620. '
  2621.       SUB ModemPut (Strng$) STATIC
  2622. '
  2623. '
  2624. ' *  SEND MODEM COMMAND
  2625. '
  2626. '
  2627.       IF ZDumbModem THEN _
  2628.          EXIT SUB
  2629.       IF NOT ZCmdsBetweenRings OR _
  2630.          NOT (INP(ZModemStatusReg) AND &H40) THEN _
  2631.          GOTO 52080
  2632.       ConnectDelay! = TIMER + 7
  2633. 52072 IF (INP(ZModemStatusReg) AND &H40) > 0 THEN _
  2634.          CALL CheckTime(ConnectDelay!, TempElapsed!, 1) : _
  2635.          IF ZSubParm = 2 THEN _
  2636.             GOTO 52080
  2637.       GOTO 52072
  2638. 52080 CALL DelayTime (ZModemCmdDelayTime)
  2639.       WasX$ = " "
  2640.       FOR WasI = 1 TO LEN(Strng$)
  2641.          LSET WasX$ = MID$(Strng$,WasI,1)
  2642.          ON INSTR("{~",WasX$) GOTO 52082,52084
  2643.             GOTO 52085
  2644. 52082       LSET WasX$ = ZCarriageReturn$
  2645.             GOTO 52085
  2646. 52084       CALL DelayTime (1)
  2647.             GOTO 52086
  2648. 52085    CALL CommPut (WasX$)
  2649. 52086 NEXT
  2650.       CALL CommPut (ZCarriageReturn$)
  2651.       END SUB
  2652. 57001 ' $SUBTITLE: 'DispCall - subroutine to display callers file'
  2653. ' $PAGE
  2654. '
  2655. '  NAME    -- DispCall
  2656. '
  2657. '  INPUTS  --     PARAMETER           MEANING
  2658. '
  2659. '  OUTPUTS --  (NONE)
  2660. '
  2661. '  PURPOSE -- Displays callers file to sysops and callers
  2662. '
  2663.       SUB DispCall STATIC
  2664.       IF ZCallersFilePrefix$ = "" THEN _
  2665.          EXIT SUB
  2666.       CALL SkipLine (1)
  2667.       CallersFileIndexTemp! = ZCallersFileIndex!
  2668.       CLOSE 4
  2669.       IF ZShareIt THEN _
  2670.          OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _
  2671.       ELSE OPEN "R",4,ZCallersFile$,64
  2672.       FIELD 4,64 AS ZCallersRecord$
  2673. 57005 IF CallersFileIndexTemp! < 1 OR ZRet THEN _
  2674.          EXIT SUB
  2675. 57010 GET 4,CallersFileIndexTemp!
  2676.       ZOutTxt$ = ZCallersRecord$
  2677.       IF LEFT$(ZOutTxt$,3) = "   " OR _
  2678.          INSTR(ZOutTxt$,"on at") = 0 THEN _
  2679.          GOTO 57030
  2680. 57025 CallersFileIndexTemp! = CallersFileIndexTemp! - 1
  2681.       GET 4,CallersFileIndexTemp!
  2682.       WasZ = INSTR(ZCallersRecord$,"{")
  2683.       IF WasZ < 1 OR WasZ > 15 THEN _
  2684.          WasZ = 15
  2685.       IF ZSysop OR _
  2686.          LEFT$(ZOutTxt$,3) <> "   " THEN _
  2687.          ZOutTxt$ = ZOutTxt$ + LEFT$(ZCallersRecord$,WasZ - 1)
  2688.       GOSUB 57100
  2689.       IF ZSysop THEN _
  2690.          ZOutTxt$ = MID$(ZCallersRecord$,WasZ) : _
  2691.          GOSUB 57100
  2692.       GOTO 57045
  2693. 57030 IF ZSysop THEN _
  2694.          GOSUB 57100
  2695. 57045 CallersFileIndexTemp! = CallersFileIndexTemp! -1
  2696.       GOTO 57005
  2697. 57100 IF INSTR(ZOutTxt$,"LOGON DENIED") THEN _
  2698.          IF NOT ZSysop THEN _
  2699.             RETURN
  2700.       CALL QuickTPut1 (ZOutTxt$)
  2701.       CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
  2702.       IF ZNo OR ZSubParm = -1 THEN _
  2703.          EXIT SUB
  2704.       RETURN
  2705.       END SUB
  2706. 58050 ' $SUBTITLE: 'AllCaps - sub to convert string to upper case'
  2707. ' $PAGE
  2708. '
  2709. '  NAME    -- AllCaps
  2710. '
  2711. '  INPUTS  --     PARAMETER           MEANING
  2712. '              ConvertField$    STRING TO MAKE UPPER CASE
  2713. '
  2714. '  OUTPUTS --  ConvertField$    CONVERTED STRINGS
  2715. '
  2716. '  PURPOSE -- Subroutine to convert a string to upper case
  2717. '
  2718.       SUB AllCaps (ConvertField$) STATIC
  2719.       IF ZTurboRBBS THEN _
  2720.          CALL RBBSULC (ConvertField$) : _
  2721.          EXIT SUB
  2722.       FOR WasZ = 1 TO LEN(ConvertField$)
  2723.          WasX = ASC(MID$(ConvertField$,WasZ,1))                      ' KG072601
  2724.          IF WasX > 96 THEN IF WasX < 123 THEN _                      ' KG072601
  2725.             MID$(ConvertField$,WasZ,1) = CHR$(WasX AND 223)          ' KG072601
  2726.       NEXT
  2727.       END SUB
  2728. 58060 ' $SUBTITLE: 'NameCaps - sub to convert name string to Proper Case'
  2729. ' $PAGE
  2730. '
  2731. '  NAME    -- NameCaps
  2732. '
  2733. '  INPUTS  --     PARAMETER           MEANING
  2734. '              ConvertField$    STRING TO CONVERT
  2735. '
  2736. '  OUTPUTS --  ConvertField$    CONVERTED STRINGS
  2737. '
  2738. '  PURPOSE -- Subroutine to convert a string to Proper Case (1st char upper)
  2739. '
  2740.       SUB NameCaps (ConvertField$) STATIC
  2741.       CALL AllCaps(ConvertField$)
  2742.       FOR WasZ = 2 TO LEN(ConvertField$)
  2743.          IF MID$(ConvertField$,WasZ,1) > "@" AND _
  2744.             MID$(ConvertField$,WasZ,1) < "[" AND _
  2745.             MID$(ConvertField$,WasZ-1,1) <> " " THEN _
  2746.             MID$(ConvertField$,WasZ,1) = CHR$(ASC(MID$(ConvertField$,WasZ,1)) OR 32)
  2747.       NEXT
  2748.       END SUB
  2749. 58070 ' $SUBTITLE: 'CheckTime - sub to see how much time is remaining'
  2750. ' $PAGE
  2751. '
  2752. '  NAME    -- CheckTime
  2753. '
  2754. '  INPUTS  -- PARAMETER               MEANING
  2755. '             TargetTime              TARGET TIME
  2756. '             ChectimeOption      1 = TELL US TIME REMAINING BETWEEN CURRENT
  2757. '                                     TIME AND TargetTime
  2758. '                                 2 = TELL US TIME ELAPSED BETWEEN TargetTime
  2759. '                                     AND CURRENT TIME
  2760. '
  2761. '  OUTPUTS -- PARAMETER               MEANING
  2762. '             TimeRemaining!      POSITIVE OR NEGATIVE NUMBER INDICATING
  2763. '                                 TIME REMAINING OR ELAPSED.  VALUE MAY BE
  2764. '                                 TESTED FOR "TIME EXPIRED".  NEGATIVE
  2765. '                                 OR ZERO, AND THE TIME HAS BEEN REACHED.
  2766. '                                 ELAPSED TIME CAN BE 0 TO 86400 (24 HRS)
  2767. '                                 TIME REMAINING CAN BE 0 TO 43200 OR
  2768. '                                  -43200 TO 0 (+ OR - 12 HRS)
  2769. '             ZSubParm (Option 1 ONLY!)
  2770. '                                 1 = Time REMAINING is > 0
  2771. '                                 2 = Time REMAINING is <= 0
  2772. '
  2773. '
  2774. '  PURPOSE -- Subroutine to provide time measurement functions.  Will
  2775. '             determine whether a target time has been reached, how much
  2776. '             time is remaining, or how much time has elapsed.
  2777. '
  2778.       SUB CheckTime (TargetTime!, TimeRemaining!, CkOption) STATIC
  2779.       IF TargetTime! > 86400 THEN _
  2780.          TestTime! = 86400 : _
  2781.          OverTime! = TargetTime! - 86400 _
  2782.       ELSE _
  2783.          TestTime! = TargetTime! : _
  2784.          OverTime! = 0
  2785.       TimeRemaining! = (TestTime! - TIMER) + OverTime!
  2786.       IF CkOption = 2 THEN GOTO 58072
  2787.       IF TimeRemaining! < -43200 THEN _
  2788.          TimeRemaining! = TimeRemaining! + 86400
  2789.       IF TimeRemaining! > 43200 THEN _
  2790.          TimeRemaining! = TimeRemaining! - 86400
  2791.       IF TimeRemaining! >= 0 THEN _
  2792.          ZSubParm = 1 _
  2793.       ELSE _
  2794.          ZSubParm = 2
  2795.       EXIT SUB
  2796. 58072 IF TimeRemaining! > 0 THEN _
  2797.          TimeRemaining! = 86400 - TimeRemaining! _
  2798.       ELSE _
  2799.          TimeRemaining! = -(TimeRemaining!)
  2800.       END SUB
  2801. 58080 ' $SUBTITLE: 'HashRBBS - sub to determine where to look for user'
  2802. ' $PAGE
  2803. '
  2804. '  NAME    -- HashRBBS
  2805. '
  2806. '  INPUTS  --     PARAMETER           MEANING
  2807. '               StringToHash$    USER NAME TO LOCATE
  2808. '               MaxPosition      MAXIMUM # USERS
  2809. '
  2810. '  OUTPUTS --     PrimeHash       WHERE TO LOOK First
  2811. '                SecondHash       LOOK THIS FAR AHEAD
  2812. '
  2813. '  PURPOSE -- Where to look for a user in users file
  2814. '             Look first at prime position, then add
  2815. '             SecondHash until find or find unused record
  2816. '
  2817.       SUB HashRBBS (StringToHash$,MaxPosition,PrimeHash,SecondHash) STATIC
  2818.       SecondHash = (ASC(MID$(StringToHash$,2,1)) * 10  + 7) MOD _
  2819.            MaxPosition
  2820.       PrimeHash = _
  2821.            ((ASC(StringToHash$) * 100  + _
  2822.              ASC(MID$(StringToHash$,(LEN(StringToHash$) / 2) + .1,1)) * _
  2823.              10  + _
  2824.              ASC(RIGHT$(StringToHash$,1))) _
  2825.              MOD MaxPosition) + 1
  2826.       END SUB
  2827. 58100 ' $SUBTITLE: 'SetOpts - sub to set prompts based on user security'
  2828. ' $PAGE
  2829. '
  2830. '  NAME    -- SetOpts
  2831. '
  2832. '  INPUTS  --     PARAMETER           MEANING
  2833. '                   First             POSITION WHERE START LOOKING
  2834. '                   Last              POSITION WHERE QUIT LOOKING
  2835. '                   ZUserSecLevel     SECURITY OF USER
  2836. '
  2837. '  OUTPUTS -- Options$              LIST OF COMMANDS USER CAN DO
  2838. '
  2839. '  PURPOSE -- String together what commands user can do in a section
  2840. '
  2841.       SUB SetOpts (Options$,InvalidOptions$,First,Last) STATIC
  2842.       Options$ = ""
  2843.       InvalidOptions$ = ""
  2844.       FOR WasI = First TO Last
  2845.          IF ZUserSecLevel < ZOptSec(WasI) THEN _
  2846.             InvalidOptions$ = InvalidOptions$ + _
  2847.                                MID$(ZAllOpts$,WasI,1) _
  2848.          ELSE IF MID$(ZAllOpts$,WasI,1) <> " " THEN _
  2849.                  Options$ = Options$ + _
  2850.                             MID$(ZAllOpts$,WasI,1)
  2851.       NEXT
  2852.       CALL SortString (Options$)
  2853.       CALL SortString (InvalidOptions$)
  2854.       END SUB
  2855. 58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins'
  2856. ' $PAGE
  2857. '
  2858. '  NAME    -- CheckNewBul
  2859. '
  2860. '  INPUTS  --     PARAMETER           MEANING
  2861. '                 LastOn$             Last DATE OF LOGON
  2862. '                                   FORMAT MM/DD/YY
  2863. '                 ZActiveBulletins  # OF BULLETING
  2864. '                 ZBulletinPrefix$  FILESPEC FOR BULLETINS
  2865. '
  2866. '  OUTPUTS --     NumNewBullets   NUMBER OF NEW BULLETINS
  2867. '                 NewBullets$      LIST OF NEW BULLET #'S
  2868. '                 ZWasQ            WHERE Last BULLETIN STORED
  2869. '                                  IN ZUserIn$()
  2870. '                 ZUserIn$()       BULLETINS #'S THAT ARE NEW
  2871. '                                    (2,3,4,...)
  2872. '
  2873. '  PURPOSE -- Checks how many bulletins have system date
  2874. '             at or later than date caller last logged on
  2875. '
  2876.       SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC
  2877.       IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _
  2878.          EXIT SUB
  2879.       ZPrevPrefix$ = ZBulletinPrefix$
  2880.       NumNewBullets = 0
  2881.       NewBullets$ = ":  "
  2882.       BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _
  2883.                    (10000# * (1900 + VAL(MID$(LastOn$,7,2))))
  2884.       CALL FindIt (ZBulletinPrefix$ + ".FCK")
  2885.       WasX = 0
  2886.       CALL QuickTPut ("Checking new bulletins",0)
  2887.       IF ZOK THEN _
  2888.          WHILE NOT EOF(2) : _
  2889.             LINE INPUT #2,WasBN$ : _
  2890.             GOSUB 58112 : _
  2891.          WEND _
  2892.       ELSE FOR WasI = 1 TO ZActiveBulletins : _
  2893.               WasBN$ = MID$(STR$(WasI),2) : _
  2894.               GOSUB 58112 : _
  2895.            NEXT
  2896.       ZWasQ = NumNewBullets + 1
  2897.       IF NumNewBullets < 1 THEN _
  2898.          NewBullets$ = ""
  2899.       CALL SkipLine (1)
  2900.       ZOutTxt$ = STR$(NumNewBullets) + _
  2901.            " New bulletin(s) since last call" + _                    ' DA071701
  2902.            NewBullets$
  2903.       CALL QuickTPut1 (ZOutTxt$)
  2904.       EXIT SUB
  2905. 58112 IF WasBN$ = "N" THEN _
  2906.          WasX$ = ZNewsFileName$ + CHR$(0) _
  2907.       ELSE WasX$ = ZBulletinPrefix$ + WasBN$ + CHR$(0)
  2908.       CALL MarkTime (WasX)
  2909.       CALL RBBSFind (WasX$,WasIX,Year,WasMM,WasDD)
  2910.       IF WasIX = 0 THEN _
  2911.          FDate# = WasDD + (100 * WasMM) + (10000# * (Year + 1980)) : _
  2912.          IF BaseDate# <= FDate# THEN _
  2913.             NumNewBullets = NumNewBullets + 1 : _
  2914.             ZUserIn$(NumNewBullets + 1) = WasBN$ : _
  2915.             NewBullets$ = NewBullets$ + _
  2916.             " " + _
  2917.             WasBN$
  2918.       RETURN
  2919.       END SUB
  2920. 58120 ' $SUBTITLE: 'SortString - sub to sort characters in a string'
  2921. ' $PAGE
  2922. '
  2923. '  NAME    -- SortString
  2924. '
  2925. '  INPUTS  --     PARAMETER           MEANING
  2926. '                 Strng$           STRING TO SORT
  2927. '
  2928. '  OUTPUTS --     Strng$           SORTED STRING
  2929. '
  2930. '  PURPOSE -- Sorts characters in passed string.
  2931. '
  2932.       SUB SortString (Strng$) STATIC
  2933.       Sort0 = LEN(Strng$)
  2934.       Sort1 = Sort0
  2935.       WasX$ = "!"
  2936. 58122 Sort1 = Sort1\2
  2937.       IF Sort1 = 0 THEN _
  2938.          EXIT SUB
  2939.       Sort2 = Sort0 - Sort1
  2940.       FOR Sort3 = 1 TO Sort2
  2941.          Sort4 = Sort3
  2942. 58124    Sort5 = Sort4 + Sort1
  2943.          IF MID$(Strng$,Sort4,1) > MID$(Strng$,Sort5,1) THEN _
  2944.             LSET WasX$ = MID$(Strng$,Sort4,1) : _
  2945.             MID$(Strng$,Sort4,1) = MID$(Strng$,Sort5,1) : _
  2946.             MID$(Strng$,Sort5,1) = WasX$ : _
  2947.             Sort4 = Sort4 - Sort1 : _
  2948.             IF Sort4 > 0 THEN _
  2949.                GOTO 58124
  2950.       NEXT
  2951.       GOTO 58122
  2952.       END SUB
  2953. 58130 ' $SUBTITLE: 'AddCommas - sub to format commands in command prompt'
  2954. ' $PAGE
  2955. '
  2956. '  NAME    -- AddCommas
  2957. '
  2958. '  INPUTS  --     PARAMETER           MEANING
  2959. '                 Strng$           STRING TO REPLACE
  2960. '
  2961. '  OUTPUTS --     Strng$           REPLACED STRING
  2962. '
  2963. '  PURPOSE -- Inserts commands between each letter in Strng$
  2964. '             and encloses in pointed brackets
  2965. '
  2966.       SUB AddCommas (Strng$) STATIC
  2967.       WasL = LEN(Strng$)
  2968.       IF WasL < 1 THEN _
  2969.          EXIT SUB
  2970.       LSET ZLineMes$ = " <" + _
  2971.                       LEFT$(Strng$,1)
  2972.       FOR WasK = 2 TO WasL
  2973.          MID$(ZLineMes$,2 * WasK,2) = "," + _
  2974.                                   MID$(Strng$,WasK,1)
  2975.       NEXT
  2976.       Strng$ = LEFT$(ZLineMes$,2 * WasL + 1) + _
  2977.                ">"
  2978.       END SUB
  2979. 58140 ' $SUBTITLE: 'LoadNew - subroutine to get latest uploads'
  2980. ' $PAGE
  2981. '
  2982. '  NAME    -- LoadNew
  2983. '
  2984. '  INPUTS  --     PARAMETER           MEANING
  2985. '               ZUpldDir$             LIST OF FILES UPLOADED
  2986. '
  2987. '  OUTPUTS --   ZOutTxt$              LATEST UPLOADS
  2988. '
  2989. '  PURPOSE -- Loads table of most recent number of uploads by date
  2990. '
  2991.       SUB LoadNew (Ara(2)) STATIC
  2992.       IF ZFMSDirectory$ = "" THEN _
  2993.          EXIT SUB
  2994.       ZPrevBase$ = ""
  2995.       FirstWarning = ZTrue                                           ' KG041103
  2996.       IF PrevLoadNew$ = ZFMSDirectory$ THEN _
  2997.          Ara(1,1) = 0 : _
  2998.          EXIT SUB
  2999. 58141 PrevLoadNew$ = ZFMSDirectory$                                  ' MK090302
  3000.       CALL OpenFMS (LastRec)
  3001.       FIELD 2, 23 AS PreDate$, _
  3002.                 2 AS WasMM$, _
  3003.                 1 AS Fill1$, _
  3004.                 2 AS WasDD$, _
  3005.                 1 AS Fill2$, _
  3006.                 2 AS Year$, _
  3007.                 (2 + ZMaxDescLen) AS Desc$, _                        ' KG071001
  3008.                 3 AS Category$, _
  3009.                 2 AS Fill4$
  3010.       MaxRecs = UBOUND(Ara,1)
  3011.       IF MaxRecs < 1 THEN _
  3012.          MaxRecs = 1 _
  3013.       ELSE IF MaxRecs > 23 THEN _
  3014.               MaxRecs = 23
  3015.       WasL = 0
  3016.       WasK = LastRec
  3017.       WHILE WasK > 0 AND WasL < MaxRecs
  3018.          GET #2,WasK
  3019.          IF INSTR("*\ ",LEFT$(PreDate$,1)) > 0 THEN _                ' MK090301
  3020.             GOTO 58142
  3021.          IF (ZCanDnldFromUp OR Category$ <> ZDefaultCatCode$) THEN _
  3022.             IF VAL(Year$) > 79 THEN _                                ' KG041103
  3023.                WasL = WasL + 1 : _                                   ' KG041103
  3024.                Ara(WasL,1) = 372! * (VAL(Year$) - 80!) + 31! * VAL(WasMM$) + VAL(WasDD$) _' KK030901
  3025.             ELSE IF FirstWarning THEN _                              ' KG041103
  3026.                     FirstWarning = ZFalse : _                        ' KG041103
  3027.                     ZWasZ$ = "Invalid FMS format " + ZFMSDirectory$ : _ ' KG041103
  3028.                     CALL PScrn (ZWasZ$) : _                          ' KG041103
  3029.                     CALL UpdtCalr (ZWasZ$,2)                         ' KG041103
  3030.          IF NOT ZCanDnldFromUp THEN _
  3031.             WasX = ZMinSecToView _
  3032.          ELSE IF Category$ = "***" THEN _
  3033.                  WasX = ZSysopSecLevel _
  3034.               ELSE IF Category$ = ZDefaultCatCode$ THEN _
  3035.                       WasX = ZMinSecToView _
  3036.               ELSE IF LEFT$(PreDate$,1) = "=" THEN _                 ' KG071001
  3037.                       CALL CheckInt (Desc$) : _                      ' KG071001
  3038.                       WasX = ZTestedIntValue _                       ' KG071001
  3039.               ELSE WasX = ZOptSec(19)                                ' KG071001
  3040.          Ara(WasL,2) = WasX
  3041. 58142    WasK = WasK - 1
  3042.       WEND
  3043.       CLOSE 2
  3044.       IF ZUpInc > 0 AND ZChainedDir$ <> "" THEN _                    ' MK090302
  3045.          ZActiveFMSDir$ = ZChainedDir$ : _                           ' MK090302
  3046.          GOTO 58141                                                  ' MK090302
  3047.       END SUB
  3048. 58150 ' $SUBTITLE: 'CountNewFiles - sub to count how many files new'
  3049. ' $PAGE
  3050. '
  3051. '  NAME    -- CountNewFiles
  3052. '
  3053. '  INPUTS  --     PARAMETER           MEANING
  3054. '                  LastOn$          Date of last logon
  3055. '                  UPLDS$            Latest uploads
  3056. '
  3057. '  OUTPUTS --    NumNewFiles       How many after last logon
  3058. '                RptPrefix$         Set to "At least " if
  3059. '                                    above is a minimum
  3060. '
  3061. '  PURPOSE -- Checks how many files in UPLDS$ were uploaded on or
  3062. '             after date of last logon that the user can download
  3063. '
  3064.       SUB CountNewFiles (LastOn$,Upld(2),NumUserFiles,RptPrefix$) STATIC
  3065.       BaseDate = 372 * (VAL(MID$(LastOn$,7,2)) - 80) + _
  3066.                   31 * (VAL(MID$(LastOn$,1,2))) + _
  3067.                   VAL(MID$(LastOn$,4,2))
  3068.       NumNewFiles = 1
  3069.       NumUserFiles = 0
  3070.       WHILE (BaseDate <= Upld(NumNewFiles,1) AND _
  3071.                 Upld(NumNewFiles,1) > 0 AND _
  3072.                 NumNewFiles < UBOUND(Upld,1))
  3073.          IF ZUserSecLevel => Upld(NumNewFiles,2) THEN _
  3074.             NumUserFiles = NumUserFiles + 1
  3075.          NumNewFiles = NumNewFiles + 1
  3076.       WEND
  3077.       IF Upld(NumNewFiles,1) < 1 THEN _
  3078.          NumNewFiles = NumNewFiles - 1
  3079.       IF BaseDate <= Upld(NumNewFiles,1) THEN _
  3080.          RptPrefix$ = "At least" _                                   ' KG072701
  3081.       ELSE RptPrefix$ = ""
  3082.       END SUB
  3083. 58160 ' $SUBTITLE: 'CountLines - sub to determine file categories '
  3084. ' $PAGE
  3085. '
  3086. '  NAME    -- CountLines
  3087. '
  3088. '  INPUTS  -- PARAMETER             MEANING
  3089. '             ZDirCatFile$          NAME OF THE FILE THAT HAS THE
  3090. '                                   NUMBER OF CATEGORIES IN IT.
  3091. '
  3092. '  OUTPUTS -- MaxEntries           NUMBER OF FILE CATEGORIES
  3093. '
  3094. '  PURPOSE -- Subroutine to count the number of categories that a
  3095. '             file can be classified into.
  3096. '
  3097.       SUB CountLines (MaxEntries) STATIC
  3098.       CALL LinesInFile (ZDirCatFile$,MaxEntries)
  3099.       MaxEntries = MaxEntries + 3
  3100.       IF MaxEntries < 10 THEN _
  3101.          MaxEntries = 10
  3102.       END SUB
  3103. 58161 ' $SUBTITLE: 'CountLines - sub to determine file categories '
  3104. ' $PAGE
  3105. '
  3106. '  NAME    -- LinesInFile
  3107. '
  3108. '  INPUTS  -- PARAMETER             MEANING
  3109. '             FilName$              Name of file to use
  3110. '
  3111. '  OUTPUTS -- LineCount                  Count of # of lines in file
  3112. '
  3113. '  PURPOSE -- Subroutine to count the number of categories that a
  3114. '             file can be classified into.
  3115. '
  3116.       SUB LinesInFile (FilName$,LineCount) STATIC
  3117.       CALL FindIt (FilName$)
  3118.       LineCount = 0
  3119.       IF ZOK THEN _
  3120.          WHILE NOT EOF(2) : _
  3121.             LineCount = LineCount + 1 : _
  3122.             LINE INPUT #2,ZOutTxt$ : _
  3123.          WEND
  3124.       CLOSE 2
  3125.       END SUB
  3126. 58162 ' $SUBTITLE: 'InitFMS - sub to initialize file management system'
  3127. ' $PAGE
  3128. '
  3129. '  NAME    -- InitFMS
  3130. '
  3131. '  INPUTS  -- PARAMETER             MEANING
  3132. '             ZFMSDirectory$
  3133. '
  3134. '  OUTPUTS -- ZCategoryName$()  ELEMENTS 1,2, POSSIBLY MORE
  3135. '             ZCategoryCode$()  ELEMENTS 1,2, POSSIBLY MORE
  3136. '             ZCategoryDesc$()  ELEMENTS 1,2, POSSIBLY MORE
  3137. '             CategoryIndex     COUNT OF # ELEMENTS IN THE FILE
  3138. '                               MANAGMENT SYSTEM
  3139. '
  3140. '  PURPOSE -- Subroutine to initialize the RBBS-PC File Management System
  3141. '
  3142.      SUB InitFMS (ZCategoryName$(1),ZCategoryCode$(1), _
  3143.                    ZCategoryDesc$(1),CategoryIndex) STATIC
  3144.       Blank$ = " "
  3145.       CategoryIndex = 0
  3146.       IF ZFMSDirectory$ <> "" THEN _
  3147.          CategoryIndex = CategoryIndex + 1 : _
  3148.          CatN$ = ZCategoryName$(CategoryIndex) : _
  3149.          CALL BreakFileName (ZFMSDirectory$,DrvPath$,CatN$,Extension$,ZFalse) : _
  3150.          ZCategoryName$(CategoryIndex) = CatN$ : _
  3151.          ZCategoryCode$(CategoryIndex) = "" : _
  3152.          ZCategoryDesc$(CategoryIndex) = "All uploads"_
  3153.       ELSE ZLimitSearchToFMS = ZFalse : _
  3154.            EXIT SUB
  3155.       IF ZLimitSearchToFMS OR ZMasterDirName$ = ZMainFMSDir$ THEN _
  3156.          CategoryIndex = CategoryIndex + 1 : _
  3157.          ZCategoryName$(CategoryIndex) = "ALL" : _
  3158.          ZCategoryCode$(CategoryIndex) = "" : _
  3159.          ZCategoryDesc$(CategoryIndex) = "All files"
  3160.       CALL FindIt (ZDirCatFile$)
  3161.       IF NOT ZOK THEN _
  3162.          EXIT SUB
  3163.       WHILE NOT EOF(2)
  3164.          CALL ReadParms (ZWorkAra$(),3,1)
  3165.          IF ZErrCode > 0 THEN _
  3166.             ZErrCode = 0 : _
  3167.             CALL PScrn (ZDirCatFile$+" invalid.  Line" + STR$(CategoryIndex) + " needs 3 parms") : _
  3168.             CALL DelayTime (4) _
  3169.          ELSE CategoryIndex = CategoryIndex + 1 : _
  3170.               ZCategoryName$(CategoryIndex) = ZWorkAra$(1) : _
  3171.               ZCategoryCode$(CategoryIndex) = ZWorkAra$(2) : _
  3172.               ZCategoryDesc$(CategoryIndex) = ZWorkAra$(3) : _
  3173.               CatR$ = ZCategoryCode$(CategoryIndex) : _
  3174.               CALL Remove (CatR$,Blank$) : _
  3175.               ZCategoryCode$(CategoryIndex) = CatR$
  3176.       WEND
  3177.       CLOSE 2
  3178.       END SUB
  3179. 58165 ' $SUBTITLE: 'DispUpDir - sub to display upload direcotry'
  3180. ' $PAGE
  3181. '
  3182. '  NAME    -- DispUpDir
  3183. '
  3184. '  INPUTS  -- PARAMETER             MEANING
  3185. '             PassedCats$         FILE "CATEGORIES" TO BE INCLUDED IN
  3186. '                                 THE SEARCH.
  3187. '             SearchString$       STRING TO SEARCH ON WITHIN THE
  3188. '                                 FILE "CATEGORIES" SELECTED
  3189. '             SearchDate$         DATE EQUAL TO OR GREATER THAN TO BE
  3190. '                                 SEARCHED FOR WITH THE "CATEGORIES"
  3191. '                                 AND THE STRING TO SEARCH.
  3192. '             DnldFlag            SET TO RECORD # OF LINE TO BEGIN
  3193. '                                 VIEWING - 0 IF AT END
  3194. '
  3195. '  OUTPUTS -- DnldFlag            WHENEVER DOWNLOAD REQUESTED, SETS
  3196. '                                 TO NEXT RECORD TO VIEW.  OTHERWISE
  3197. '                                 LEAVES AT ZERO
  3198. '  PURPOSE -- Display the files that meet the criteria selected in
  3199. '             RBBS-PC upload management system on the users screen.
  3200. '
  3201.       SUB DispUpDir (PassedCats$,SearchString$, _
  3202.                     SearchDate$,DnldFlag,AbortIndex) STATIC
  3203.       CALL AllCaps (SearchString$)
  3204.       Blank$ = " "
  3205.       ZStopInterrupts = ZFalse
  3206.       ZLastIndex = 0
  3207.       Categories$ = "," + _
  3208.                     PassedCats$ + _
  3209.                     ","
  3210.       CanDnld = (ZUserSecLevel => ZOptSec(19))
  3211.       CanView = (ZUserSecLevel => ZOptSec(26))                       ' KG082001
  3212.       ZJumpSupported = ZTrue
  3213.       ZJumpSearching = ZFalse
  3214.       GOSUB 58185
  3215.       IF DnldFlag > 0 THEN _
  3216.          UpldIndex = DnldFlag : _
  3217.          DnldFlag = 0 : _
  3218.          GOTO 58180
  3219.       ZJumpLast$ = ""
  3220.       SearchFor$ = SearchString$
  3221.       ExtraPrompt$ = LEFT$(",V)iew",-(6+4*ZExpertUser)*CanView)      ' KG082001
  3222.       IF CanDnld THEN _
  3223.          IF ZTurboKeyUser THEN _
  3224.             ExtraPrompt$ = ExtraPrompt$ + ",D)ownload" _
  3225.          ELSE ExtraPrompt$ = ExtraPrompt$ + ", file(s) to dwnld"
  3226.       MaxPrint = ZPageLength - 1
  3227.       BelowMinSec = (ZUserSecLevel < ZMinSecToView)
  3228.       ZNonStop = ZNonStop OR (ZPageLength < 1)
  3229.       FMSCheckPoint = 0
  3230.       WildSearch = (INSTR(SearchString$,"?") > 0) _
  3231.                      OR (INSTR(SearchString$,"*") > 0)
  3232. 58168 UpldIndex = UpldIndex + ZUpInc
  3233.       IF UpldIndex = CutoffRec THEN _
  3234.          GOTO 58182
  3235.       GET #2,UpldIndex
  3236.       FMSCheckPoint = FMSCheckPoint + 1
  3237.       ON INSTR("\* =",LEFT$(PartToPrint$,1)) GOTO 58168,58171,58170,58169
  3238.       GOTO 58172
  3239. 58169 CALL CheckInt (MID$(PartToPrint$,34))
  3240.       IF ZUserSecLevel < ZTestedIntValue THEN _
  3241.          LastOK = ZFalse : _
  3242.          FailedSearch = ZFalse : _                                   ' DA042401
  3243.          GOTO 58168
  3244.       MID$(PartToPrint$,1,13) = MID$(PartToPrint$,2,12) + " "
  3245.       ZWasA = LEN(STR$(ZTestedIntValue))
  3246.       MID$(PartToPrint$,34) = MID$(PartToPrint$,34 + ZWasA) + SPACE$(ZWasA)
  3247.       GOTO 58172
  3248. 58170 IF ZExtendedOff THEN _
  3249.          GOTO 58168 _
  3250.       ELSE IF LastOK THEN _
  3251.          GOTO 58175 _
  3252.       ELSE IF ZJumpSearching THEN _
  3253.               GOTO 58187 _
  3254.            ELSE IF SearchString$ <> "" AND (NOT WildSearch) AND FailedSearch THEN _
  3255.                    GOTO 58187 _
  3256.                 ELSE GOTO 58168
  3257. 58171 IF Category$ = "***" THEN _
  3258.          GOTO 58176 _
  3259.       ELSE HoldCat$ = "," + Category$ + "," : _
  3260.            IF INSTR(Categories$,HoldCat$) > 0 THEN _
  3261.               GOTO 58176 _
  3262.            ELSE GOTO 58168
  3263. 58172 LastOK = ZFalse
  3264.       FailedSearch = ZFalse
  3265.       LastFName = UpldIndex
  3266.       IF Category$ = "***" THEN _
  3267.          IF NOT ZSysop THEN _
  3268.             GOTO 58178
  3269.       IF Category$ = ZDefaultCatCode$ THEN _
  3270.          IF BelowMinSec THEN _
  3271.             GOTO 58178
  3272. 58173 IF LEN(Categories$) > 2 THEN _
  3273.          HoldCat$ = "," + _
  3274.                 Category$ + _
  3275.                 "," : _
  3276.          CALL Remove (HoldCat$,Blank$) : _
  3277.          IF INSTR(Categories$,HoldCat$) = 0 THEN _
  3278.             GOTO 58178
  3279.       IF ZJumpSearching OR SearchString$ <> "" THEN _
  3280.          ZOutTxt$ = PartToPrint$ : _
  3281.          IF WildSearch THEN _
  3282.             Temp$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ")-1) : _
  3283.             Temp$ = MID$(Temp$,1-(LEFT$(Temp$,1)="=")) : _
  3284.             CALL WildFile (SearchString$,Temp$,ZOK) : _
  3285.             IF ZOK THEN _
  3286.                FoundString$ = SearchString$ : _
  3287.                GOTO 58175 _
  3288.             ELSE GOTO 58178 _
  3289.          ELSE CALL AllCaps (ZOutTxt$) : _
  3290.               HiLitePos = INSTR(ZOutTxt$,SearchFor$) : _
  3291.               IF HiLitePos = 0 THEN _
  3292.                  FailedSearch = ZTrue : _
  3293.                  GOTO 58178 _
  3294.               ELSE HiLiteRec = UpldIndex : _
  3295.                    FoundString$ = SearchFor$ : _
  3296.                    IF ZJumpSearching THEN _
  3297.                       ZJumpSearching = ZFalse : _
  3298.                       SearchFor$ = PrevSearch$
  3299. 58174 IF SearchDate$ <> "" THEN _
  3300.          HoldCat$ = MID$(PartToPrint$,30,2) + _
  3301.                 MID$(PartToPrint$,24,2) + _
  3302.                 MID$(PartToPrint$,27,2) : _
  3303.          IF HoldCat$ < SearchDate$ THEN _
  3304.             IF ZDateOrderedFMS THEN _
  3305.                GOTO 58183 _
  3306.             ELSE GOTO 58168
  3307. '
  3308. '
  3309. ' * Allow the FMS to be both fast and interruptable if a local
  3310. ' * user or there is nothing in the input buffer by using QuickTPut.
  3311. '
  3312. '
  3313. 58175 LastOK = ZTrue
  3314. 58176 ZWasA = EndDesc
  3315.       IF LEFT$(PartToPrint$,5) = "     " THEN _
  3316.          GOTO 58178
  3317.       ZOutTxt$ = PartToPrint$
  3318.       CALL TrimTrail (ZOutTxt$," ")
  3319.       CALL ColorDir (ZOutTxt$,"Y")
  3320.       IF UpldIndex = HiLiteRec THEN _
  3321.          HiLiteRec = -1 : _
  3322.          HiLitePos = 0 : _
  3323.          CALL CheckColor (ZOutTxt$,FoundString$,"")
  3324. 58177 IF ZLocalUser THEN _
  3325.          CALL QuickTPut1 (ZOutTxt$) : _
  3326.          GOTO 58178
  3327.       CALL EofComm (Char)
  3328.       IF Char = -1 THEN _
  3329.          CALL QuickTPut1 (ZOutTxt$) _
  3330.       ELSE ZSubParm = 5 : _
  3331.            CALL TPut : _
  3332.            IF ZRet THEN _
  3333.               GOTO 58183
  3334. 58178 IF ZLinesPrinted <= MaxPrint AND (FMSCheckPoint MOD 1000 <> 0) THEN _  ' DA071803
  3335.          GOTO 58168
  3336.       CALL CheckCarrier
  3337.       IF ZSubParm = -1 THEN _
  3338.          GOTO 58183
  3339.       CALL TimeRemain (MinsRemaining)
  3340.       IF MinsRemaining <= 0 THEN _
  3341.          ZSubParm = -1 : _
  3342.          GOTO 58183
  3343.       IF ZNonStop THEN _
  3344.          GOTO 58168
  3345.       IF ZLinesPrinted <= MaxPrint THEN _
  3346.          IF ZDateOrderedFMS THEN _                                   ' DA071803
  3347.             CALL QuickTPut1 (ZEmphasizeOff$ + _                      ' DA071803
  3348.                "Files checked thru " + MID$(PartToPrint$,24,8)) _    ' DA071803
  3349.          ELSE _                                                      ' DA071803
  3350.             CALL QuickTPut1 (ZEmphasizeOff$ + STR$(FMSCheckPoint) + _  ' DA071803
  3351.                " files checked")                                     ' DA071803
  3352. 58180 ZTurboKey = -ZTurboKeyUser
  3353.       ZStackC = ZTrue
  3354.       CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse)
  3355.       IF ZSubParm = -1 THEN _
  3356.          GOTO 58183
  3357.       IF ZNo THEN _
  3358.          GOTO 58183
  3359.       CALL AllCaps (ZUserIn$(1))
  3360.       IF ZUserIn$(1) = "V" THEN IF CanView THEN _                    ' KG082001
  3361.          ZLastIndex = ZWasQ : _
  3362.          ZAnsIndex = 1 : _
  3363.          CALL GetArc : _
  3364.          ZJumpSupported = ZTrue : _                                  ' KG022201
  3365.          ZWasA = UpldIndex : _
  3366.          GOSUB 58185 : _
  3367.          UpldIndex = ZWasA : _
  3368.          GOTO 58180
  3369.       IF ZUserIn$(1) = "D" THEN IF CanDnld THEN _                    ' KG090101
  3370.          ZOutTxt$ = "Download what file(s)" : _
  3371.          ZStackC = ZTrue : _
  3372.          CALL PopCmdStack : _
  3373.          IF ZWasQ = 0 THEN _
  3374.             GOTO 58180
  3375.       IF ZJumpSearching THEN _
  3376.          PrevSearch$ = SearchFor$ : _
  3377.          SearchFor$ = ZJumpTo$ _
  3378.       ELSE SearchFor$ = SearchString$ : _
  3379.            IF LEN(ZUserIn$(1)) > 1 THEN _
  3380.            IF NOT ZYes AND CanDnld THEN _
  3381.               CALL SkipLine (1) : _
  3382.               DnldFlag = UpldIndex : _
  3383.               ZLastIndex = ZWasQ : _
  3384.               ZAnsIndex = 1 : _
  3385.               EXIT SUB
  3386.       IF ZNonStop THEN IF UpldIndex > 999 THEN _
  3387.          IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _
  3388.             ZOutTxt$ = STR$(UpldIndex) + _
  3389.                " lines left to search.  Really go non-stop? (Y/[N])" : _
  3390.             ZNoAdvance = ZTrue : _
  3391.             ZTurboKey = -ZTurboKeyUser : _
  3392.             ZSubParm = 1 : _
  3393.             CALL TGet : _
  3394.             CALL WipeLine (79) : _
  3395.             ZNonStop = ZYes                                          ' DA071803
  3396.       GOTO 58168
  3397. 58182 IF ZChainedDir$ <> "" THEN _
  3398.          ZActiveFMSDir$ = ZChainedDir$ : _
  3399.          GOSUB 58185 : _
  3400.          GOTO 58168
  3401. 58183 CLOSE 2
  3402.       ZNonStop = (ZPageLength < 1)
  3403.       ZStopInterrupts = ZFalse
  3404.       ZOutTxt$ = ""
  3405.       ZActiveFMSDir$ = ""                                            ' KG031801
  3406.       ZJumpSupported = ZFalse
  3407.       EXIT SUB
  3408. 58185 CALL OpenFMS (UpldIndex)
  3409.       EndDesc = 33 + ZMaxDescLen
  3410.       FIELD 2, EndDesc AS PartToPrint$, _
  3411.                3 AS Category$, _
  3412.                2 AS Filler$
  3413.       PrevFMS$ = ZActiveFMSDir$
  3414.       IF ZUpInc = -1 THEN _
  3415.          CutoffRec = 0 : _
  3416.          UpldIndex = UpldIndex + 1 _
  3417.       ELSE CutoffRec = UpldIndex + 1 : _
  3418.            UpldIndex = 0
  3419.       RETURN
  3420. 58187 ZOutTxt$ = PartToPrint$
  3421.       CALL AllCaps (ZOutTxt$)
  3422.       HiLitePos = INSTR(ZOutTxt$,SearchFor$)
  3423.       IF HiLitePos < 1 THEN _
  3424.          GOTO 58168
  3425.       HiLiteRec = UpldIndex
  3426.       UpldIndex = LastFName
  3427.       GET 2,UpldIndex
  3428.       FoundString$ = SearchFor$
  3429.       IF ZJumpSearching THEN _
  3430.          SearchFor$ = PrevSearch$
  3431.       GOTO 58175
  3432.       END SUB
  3433.